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I.   INTRODUCTION 


A.   AN  INTRODUCTION  TO  THfc.  PASCAL  LANGUAGE 

PASCAL  was  the  first  proqramminq  language  to  emoody  the 
conceot  of  structurea  programming  defined  by  Edsger  Dykstra 
and  C.  A.  R.  Hoare  17],  and  was  developed  by  Nicklaus  wirth 
at  Eigenossisch  lechnische  Hochschule  in  Zurich/ 
Switzerland.  Preliminary  versions  of  the  PASCAL  language 
were  drafted  in  19fcH  followinq  the  spirit  of  the  ALGOL-bO 
and  ALGOL- ii"«i  Drogramminq  languages  [lOj.  The  first  PASCAL 
compiler  became  ooerational  in  1970  and  its  publication 
followea  a  vear  later.  In  1975/  a  revised  PASCAL  report  was 
put;lisheq  consoliaatinq  revisions  resulting  from  two  years 
of  use  and  experience. 


The  aevelooment  of  the  language  PASCAL  was  based  upon 
two  principal  aimsJ  to  be  more  oowerful  than  its 
predecessors  and  to  orovide  a  suitable  language  to  teach 
structured  programming.  The  extensions  of  PASCAL  relative 
to  ALGOL-bO  lie  in  the  data  structuring  facilities  that 
expand  its  range  of  applicability.  PASCAL  introduces  record 
and  file  structures  that  make  it  possible  to  program  both 
commercial  and  scientific  applications. 


B.   OBJECTIVES  OF  NPS-PASCAL 

The  major  objective  of  the  project  described  here  was  to 
provide  the  basis  for  an  i  nnp  1  ement  a  t  i  on  of  the  PASCAL 
language  on  an  Intel  808  0  microcon-outer  system.  PASCAL  was 
chosen  because  of  its  flexible  tyoe  declarations  as  well  as 
its  structured  programming  constructs.  The  rapid 
development  and  decreasing  costs  of  microcomputer  hardware^ 
coupled  witn  sophisticated  compatible  software  is  allowing 
the  microcomputer  to  be  used  in  a  large  number  of 
applications.  The  availability  of  another  high  level 
language  for  these  systems  can  only  increase  their 
usefulness  and  acceptability. 


'^j  PS-PASCAL  was  ceveloped  to  run  on  an  8  0  80  based 
microcomputer  system  using  the  high  level  language  PL/M  [9]  . 
PL/i^  is  implemented  through  a  cross  compiler  for  8080 
microprocessor  systems^  and  executes  on  the  Naval 
Postgraduate  School's  18.^  3o0  computer.  The  availability  of 
the  8080  based  CP/M  cisk  operating  system  simulator  (CPSYM) 
on  the  IBM  3b0f  with  its  Powerful  debu going  capabilities* 
was  also  an  important  factor  in  the  choice  of  the  8080 
microprocessor  and  the  CP/M  operating  system. 


II.   NPS-HASCAL  LANGUAGE  OtSCRIPTION 


A.  BACKGROUND 

NPS-PASCAL  is  an  implementation  of  PASCAL  with  slight 
deviations  to  allow  NPS-PASCAL  to  be  specified  by  an  LALR(1) 
grammar  form.  This  permitted  the  use  of  the  University  of 
Toronto's  como i 1 e r-comp i 1 er  oarse  table  generator  lib]. 
NPS-PASCAL  allows  simple  conversions  to  PASCAL  and  back 
which  will  become  incneasinaly  important  as  the  number  of 
availaole  PASCAL  application  programs  increases.  The 
differences  between  the  PASCAL  structure  and  NPS-PASCAL  are 
given  oelow. 

B.  FEATURES  OF  THE  NPS-PASCAL  LANGUAGE 

1.   NPS-PASCAL  Declarations 

NPS-PASCAL  recuires  that  all  labels/  constants^  user 
defined  types/  and  variables  be  declared  prior  to  their  use 
in  the  program  body.  This  is  accomplishea  by  a  series  of 
declarations  and  definitions  in  seguence  at  the  beginning  of 
the  program.  The  program  heading  is  used  to  declare  the 
input  and  outout  files  which  can  be  accessed  by  the  program. 
The  input  and  output  aeclarations  are  discussed  in  section 
5.  Procedures  functions/  which  may  contain  local 
declarations/  must  also  be  defined  prior  to  their  invocation 
in   the  proaram.   Althouah  procedure  and  function  calls  were 
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not  i mo  1 ement ed  in  NPS-PASCAL,  it  was  intended  that  these 
structures  would  be  recursive. 

a.   Label  Declarations 

Labels  are  used  by  I'JPS-PAbCAL  c3S  the  target  of 
all  GOTO  statements  in  the  program,  Laoels  can  be  any 
positive  integer  value  up  to  thirty  digits  in   length.   This 

* 

differs  from  PASCAL.  NPS-PASCAL  treats  the  label  as  a 
identifier  while  PASCAL  recognizes  it  as  an  integer  value, 
when  labels  are  used  in  the  program  their  declaration  must 
appear  immediately  following  the  program  heading.  The  only 
factor  that  restricts  the  number  of  labels  in  a  given 
program  is  the  available  memory  of  the  microcomputer 
executing  the  "^i PS-PASCAL  compiler.  Sufficient  memory  must 
oe  available  after  the  comoiler  is  loaded  for  the  symbol 
table  entries  generated  oy  each  laoel  declaration.  This 
size  restriction  also  applies  to  all  declarations. 

o.   Constant  Declarations 

Constant  declarations  enable  the  programmer  to 
introduce  an  identifier  as  a  synonym  for  a  valid  constant. 
A  constant  is  either  a  number,  a  constant  identifier 
(possibly  signed)  or  a  string.  Constant  identifiers  usually 
allow  a  programmer  to  write  more  readable  and  self- 
documenting  programs. 

c.   Type  Declarations 

One  of  t^e  greatest  strengths  of  the  PASCAL 
language   is   the   ability   to  define  unigue  data  types.   In 
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NPS-PASCAL  there  are  four  standard  types:  Boolean^  Integer* 
Char  (character)*  and  Real.  Integers  may  be  any  value 
between  -32,768  and  +3(?/767,  Real  values  are  represented 
internally  in  an  exponential  format  and  can  take  on  any 
positive  or  negative  value  consisting  of  fourteen  digits 
multiolied  by  ten  to  the  -b^th  power  through  ten  to  the 
+63rd  power.  Characters  may  be  any  valid  ASCII  character. 
The  two  identifier  constant  values  of  TRUE  and  FALSt  can  be 
assigned  to  a  variable  of  type  Boolean, 

In  addition  to  the  above  scalar  types*  there 
exists  the  capability  of  declaring  a  user  defined  scalar 
type.  A  series  of  iaentifiers  in  seguence  can  be  given  an 
identifying  name*  making  up  this  user  defined  type.  A  type 
may  also  be  defined  as  a  subrange  of  any  previously  defined 
scalar  type*  except  Boolean  and  real*  by  indicating  the 
smallest  and  largest  value  in  the  subrange.  The  order  in 
which  the  user  defined  scalar  type  identifiers  are  declared 
determines  the  highest  and  lowest  values  of  that  type.  The 
first  identifier  becomes  the  lowest  value  of  that  type* 
while  the  last  becomes  the  highest. 

Structured  types  are  defined  by  descrit)ing  the 
individual  types  of  their  components  and  by  indicating  which 
structuring  method  is  to  be  applied.  This  determines  each 
component's  location  in  the  structure.  NPS-PASCAL  supports 
the  four  type  structures  of  PASCAL:  array  structures*  record 
structures*  set  structures*  and  file  structures. 
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(1)  Array  Structures 

Array  structures  contain  two  or  more 
components  of  the  same  declared  type.  Arrays  are  indexed 
with  up  to  five  dimensions.  Each  dimension  is  defined  by  a 
user  defined  scalar  type  or  a  subrange  of  the  integers. 
Components  may  be  declared  as  any  valid  tyoe.  If  arrays  are 
nested  (the  components  of  the  array  are  arrays)  then  a 
maximum  of  five  levels  are  allowed. 

(2)  Record  Structures 

Unlike  the  array  structure*  the  record 
structure's  comoonents/  called  fields*  are  not  necessarily 
of  the  same  type.  Each  field  in  the  record  structure  must 
be  assigned  a  valia  type*  which  possibly  could  be  another 
record.  Nesting  of  records  is  allowed  uo  to  four  levels  of 
declaration.  iaentifiers  are  associated  with  each  fiela* 
and  are  used  for  selection  rather  than  a  computable  index 
like  that  of  an  array.  Records  may  vary  in  length  with  the 
restriction  that  the  variable  part  of  each  record  must  be 
the  last  portion  of  that  record.  The  variant  part  of  a 
record  cannot  contain  anotrter  record  with  a  variant  part. 

(3)  Set  Structures 

The  set  structure  defines  a  set  of  values* 
which  is  the  power  set  of  a  declared  base  type.  The  base 
type  is  usually  a  user  defined  scalar  type  or  a  subrange  of 
the  type  integer.  The  maximum  number  of  elements  in  the  set 
cannot  exceed  sixteen  including  the  null  set. 
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i^)       File  St  rue  t  ures 

A  file  structure  is  a  sequence  of  components 
of  tne  same  type  v»hose  position  in  the  fHe  defines  the 
element's  order.  Only  one  element  is  accessible  at  any  one 
time  during  execution  of  a  program.  Subsequent  items  must 
be  accessed  sequentially.  The  manipulation  of  file 
structures  was  not  implemented  in  NPS-PASCAL. 

d.   Variable  Declarations 

NPS-PASCAL  supports  botn  static  and  dynamic 
variables.  Every  variable  is  bound  to  a  particular  type 
during  aeclaration.  Dynamic  variables  are  referred  to  as 
pointer  type  variables.  They  each  may  point  to  only  one 
declared  type  which  provides  data  protection.  Pointer 
variaoles  may  also  occur  in  structures/  as  in  record 
structures/  which  are    themselves  dynamically  generated. 

2.       Arithmetic  Processing 

Integer  and  binary  coded   decimal   (BCD)   arithmetic 
are  supported    by    NPS-PASCAL,    In   addition,   the   set 

operations  in  (set  membership)/  +  (union)/  *  (intersection)/ 
(set  difference)/  and  all  of  the  relational  operators  are 
also  defined.  The  relational  operators  provided  in  NPS- 
PASCAL  are:  ~  (equal)/  <>  (not  equal)/  <=  (less  than  or 
equal)/  >=  (greater  or  egual)/  <  (less  than)/  and  >  (greater 
than).  The  three  logical  Boolean  operators  AND/  UR/  and  islOT 
are    also  defined. 
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3.   Control  Structures 

NPS-PASCAL  employs  several  useful  control  structures 
consisting  of  BEGIN  -  ENf)  blocks  for  comoound  statements/  IF 
THEN  and  IF  THEN  ELSE  conditional  statements^  CASE-OF 
selective  statements^  REPE A T -UNT IL ,  WHILE,  and  FOR 
repetitive  statements*  and  procedure  statements.  NPS-PASCAL 
is  a  block  structured  language,  much  like  ALGOL-60  in  that 
each  block  is  bracketed  by  a  BEGIN  and  an  END,  Blocks  may 
be  nested  within  other  blocks  ud  to  and  including  the  tenth 
level  of  nesting.  This  nesting  restriction  also  applies  to 
conditional  and  repetitive  statements. 

Unlike  ALGOL-bO,  BEGIN-END  blocks  do  not  restrict 
the  scope  of  defined  variables  within  the  program.  All 
variable  procedure  and  function  names  must  be  uniguely 
declared  globally  in  the  program.  Variables  declared  within 
a  procedure  or  function,  however,  have  their  scope  limited 
to  the  range  of  that  procedure.  Procedure  nesting  is 
allowed  with  the  same  variable  scope  restrictions  applicable 
to  inner  procedures  or  functions.  Storage  for  statically 
declared  variables  remains  allocated  throughout  the  program. 
Storage  for  local  variables  within  procedures  and  functions, 
as  well  as  dynamically  generated  variables,  is  allocated  as 
reguired.  The  storage  for  the  dynamically  assigned 
variables  is  returned  to  free  storage  at  Yun  time  for 
reassignment  when  no  longer  in  use.  The  run  time  storage 
allocation  management  routines  were  not  implemented  in  iN PS- 
PASCAL. 
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^.   Proceaures  Ana  Functions 

Staterrents  which  can  be  qiven  user  defined 
identifiers  are  called  procedures.  A  procedure  is  invoked 
in  the  program  by  its  identifier.  Procedures  and  functions 
are  declared  in  the  declaration  portion  of  the  program. 
Each  may  contain  local  variable  declarations/  as  explained 
above/  in  addition  to  formal  parameters.  There  are  three 
types  of  acceptable  formal  parameter  specifications:  value 
parameters/  variable  parameters/  and  procedure  or  function 
parameters.  Value  parameters  (call  by  value)  are 
expressions  in  the  calling  staten^ent  that  are  evaluated  once 
at  activation  of  the  procedure.  The  actual  parameter  is  the 
evaluated  expression.  The  formal  parameter  represents  a 
local  variable  within  the  procedure.  Variable  parameters 
(call  by  reference)  are  addresses  of  variables  in  the 
callina  program.  The  actual  parameter  is  a  variable  whose 
indices  are  evaluated/  if  reguired/  prior  to  the  execution 
of  the  procedure.  The  formal  parameter  is  given  the  same 
address  and  must  be  of  the  same  tyoe  when  used.  Procedure 
or  function  oarameters  are  evaluated  each  time  they  are 
used.  The  actual  parameter  is  a  function  or  procedure 
identifier. 

Functions  and  procedures  are  declared  in  the  same 
manner  except  that  each  function  has  an  associated  type. 
When  a  function  is  referenced  in  an  expression/  the  function 
produces  a  value  which  is  returned  in  place  of  the  call. 
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5 ,   Input  And  Output 

N PS-PASCAL  has  four  separate  statements  which 
accomplish  all  input  ana  output  for  the  program.  PEAL)  ana 
READLN  statements  are  used  either  to  read  from  the  console^ 
the  aefault  input  aevice/  or  from  a  file  when  one  is 
specified.  If  a  file  is  snecifiea^  the  file  name  must  be 
declared  in  the  program  heading^  and  the  file  type  must  be 
specified  in  a  file  type  declaration.  These  rules  aoply  to 
output  files  as  well.  Text  files  declared  to  be  of  type 
character  are  a  special  case.  For  this*  a  call  to  the 
procedure  READLN  will  read  the  characters  specified  and  then 
skip  to  the  next  line  (the  character  following  the  next 
carriage  return  and  line  feed).  i/^RITE  and  v'liPITELN  are  used 
to  either  write  to  the  consolef  or  to  a  file  specified  in 
the  program  heading.  The  data  to  be  read  or  written  is 
specified  by  variables  or  strings  in  guotation  marks  which 
are  enclosed  within  parentheses.  Any  comoination  of  integer 
variables  or  guoted  strings  may  be  placed  between 
parentheses  and  separated  by  commas.  A  a  guoted  string  in  a 
read  statement  is  treated  as  a  comment.  The  maximum  numoer 
of  characters  printed  on  a  line  is  80.  »^hen  the  output  from 
a  given  ^IRlJiL ,  or  wRITELN  specification  reaches  BU 
characters/  a  carriage  return  and  a  line  feed  character  are 
automatically  issued.  If  the  WRITELN  statement  is  used/  the 
carriage  return  and  line  feed  are  generated  after  processing 
the  final  parameter  in  the  statement. 

The  built-in  functions  of  PUT  and  GET  were  not 
implemented   in  NPS-PASCAL.   In  addition,  the  predicate  EOF, 
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which  is  used  to  mark  the  end  of  a  file  being  processeO/  was 
also  ofTi  i  t  t  ed  . 
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III.   IMPLtMENTATIUN 


A.   COMPILER  IMPLEMENTATION 

1.       CofTiDiler    Organization 

The  comoiler  was  designed  to  read  source  language 
statements  from  a  aiskette  and  to  produce  an  intermediate 
language  file  while  orinting  an  ootional  source  listing  at 
the  console.  A  one  pass  aooroacn  was  used  to  orovide  a  fast 
compilation/  as  well  as  to  reouce  the  reauired  work  and  size 
of  the  compiler.  To  eliminate  the  need  to  perform  a 
complete  second  oass  of  the  source  file>  labels  are  placed 
in  the  intermediate  code  at  the  position  where  t^e  execution 
of  tne  orogram  is  to  continue  after  a  orancn.  This  was  done 
because  the  exact  location  of  each  branch  is  not  known 
during  the  compilation  phase.  The  resolution  of  label 
locations  is  accomolished  by  the  code  generating  program  as 
it  scans  the  intermediate  code.  The  coae  generating  program 
is  hereafter  refered  to  as  the  translator. 

The  sinale  pass  of  the  compiler  builds  the  symbol 
table/  converts  all  numbers  in  the  source  program  to  their 
internal  representation^  generates  the  intermediate  file  on 
the  disk/  and  provides  an  optional  listing  of  the  source 
statements  at  the  console.  Token  and  production  numbers  are 
also  listed  for  each  line  if  desired.  If  program  errors  are 
anticipated/  the  comoiler  can  also  surpress   the   generation 
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of  the  intermediate  file  by  the  setting  of  specific   toggles 
at  the  beginning  of  the  orogrann. 

2 ,       Scanner 

The  scanner  analyzes  the  source  orogram  character  by 
character  and  sends  a  seauence  of  tokens  to  the  parser.  The 
scanner  also  provides  a  listing  of  the  source  statements 
when  directed/  eliminates  commentSr  and  sets  the  compiler 
toqg 1 es , 

The  scanner  is  divided  into  four  main  sections  which 
are  selectively  executed  depending  on  the  first  non-blank 
character  of  the  token.  After  the  first  character  is 
scanned/  the  individual  section  involveo  scans  the  remainder 
of  the  token  and  places  it  in  the  accumulator  (ACCUM).  The 
first  Dvte  of  ACCU^'  contains  the  length  of  the  token.  In 
the  case  of  tokens  that  exceed  the  size  of  ACCOM  (32  bytes) 
a  continuation  flag  is  set  which  permits  the  scanner  and 
parser  to  subseguently  accept  the  remaining  portion  of  the 
token . 

The  four  sections  of  the  scanner  handle  strings/ 
numbers/  identifiers  or  reservea  wordS/  and  special 
characters.  The  strina  processing  section  is  invoked 
whenever  the  first  character  of  a  token  is  a  single 
ouotation  mark.  The  process  then  analyzes  each  succeeding 
character  until  a  second  guotation  mark  is  scanned 
indicatina  the  end  of  the  string.  The  program  section  that 
manipulates  numbers  determines  the  type  of  number  being 
scanned  as  it  processes  each  character.   This   oe t e rm i na t i on 
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is  used  by  subsequent  routines  that  oerform  type  checking 
and  conversion  to  internal  representation,  when  the  scanner 
recoqnizes  an  identifier  it  searches  the  vocabulary  table 
CVOCAS)  to  deternnine  if  the  identifier  is  a  reservea  word. 
If  a  reserved  word  is  matched,  the  scanner  returns  the 
position  of  the  word  in  the  VOCAB  table  to  the  parser.  This 
position  corresponds  to  the  assi,aned  token  number.  The 
VOCAB  table  is  one  of  the  tables  provided  by  the  LALR(l) 
parse  table  generator  [151. 

Special  characters  are  handled  separately/  except  in 
two  cases.  If  a  period  is  followed  by  numeric  characters 
without  intervening  spaces,  the  program  section  which 
processes  special  characters  assumes  that  a  real  number  is 
being  scanned.  This  program  section  handles  the  number  in 
the  same  manner  as  does  the  number  section. 

If  a  pair  of  special  characters  are  scanned  one  right 
after  another,  the  scanner  will  pass  both  characters  as  a 
single  totcen  after  assigning  the  token  number  from  the  VOCAB 
table. 

3 .   Symbo 1  Table 

The  symbol  table  is  used  to  store  the  attributes  of 
labels,  constants,  type  declarations,  variable  iaentifiers, 
procedures  and  functions,  and  file  declarations.  The  main 
function  of  the  symbol  table  is  to  verify  program  semantics 
and  table  symbol  characteristics  which  are  used  in  the 
generation  of  the  intermediate  code  file.  Access  to  the 
symbol   table   is   accomplished   through   various   primitive 
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suDroutines  using  based  qlobal  variables  to  uniquely  adaress 
the  eletients  of    each  entry. 

The  symbol  table  is  modeled  after  the  ALGOL-M  symbol 
table  [5).  It  is  an  unordered  linked  list  of  entries  which 
grows  towarci  the  top  of  memory.  Individual  entries  are 
either  accessea  via  a  chained  hash  adaressinq  techniaue  as 
illustrated  in  Figure  1/  or  by  means  of  address  pointer 
fields  contained  in  other  entries.  The  later  method  of 
access  is  required  since  not  all  entries  in  the  symbol  table 
have  an  identifier/  called  the  printname^  associated  with 
them. 

Fach  location  in  the  hash  table  heads  a  linked  list 
of  entries  whose  printnamef  when  evaluated/  results  in  the 
same  hash  value.  A  zero  in  any  location  in  the  hashtable 
indicates  that  there  are  no  entries  whose  orintname  produces 
that  value.  During  symbol  table  construction  or  access/  the 
global  variaole  PRINFNAME  contains  the  aadress  of  a  vector 
whose  first  element  is  the  length  of  an  identifier  in  a 
single  byte/  followed  by  the  identifier's  characters 
represented  in  ASCII  format.  The  variable  SYMHASH  contains 
the  hashcode  value/  the  sum  of  the  orintname's  ASCII 
characters  modulo  l^fl.  Entries  that  produce  the  same  hash 
code  value  are  linked  together  in  the  symbol  table  by  a 
chain  which  is  accessed  via  the  individual  entry's  collision 
field.  The  chain  is  constructed  in  such  a  wav  as  to  have 
the  latest  entry  constructed  at  the  head  of  the  chain. 

There  are  eight  different  types  of  entries  that  can 
be   found   in   the   NPS-PASC^L   symbol   table.    Each   entry 
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HASHING  FUNCTION 


SUM  OF  PRINTNAMES  ASCII  CHARACTERS 
MODULO  128 
H.F.(AB)  =  (41  +  42)  MOD  128  =  83 

H.F.(BA)  =  (42  +  41)  MOD  128  =  83 
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contains  a  nunnber  of  fields/  some  of  which  are  common  to  all 
entries/  and  some  of  which  aop I y  only  to  oarticular  types  of 
entries.  All  entries  have  the  same  first  three  fields:  the 
collision  field  (first  two  bytes)/  the  previous  symbol  table 
entry  address  f i e 1  a  ( PRVSSB TBLSENTR Y  -  located  in  the  third 
and  fourth  bytes)/  and  the  form  field  (FOKM  -  the  fifth 
byte)/  as  shown  on  Figure  2 ,  The  remaining  fields  are  used 
to  uniquely  describe  each  entry's  attributes  and  particular 
identifying  characteristics. 

a  ,   Labe 1  Entries 

The  form  fiela  of  a  laoel  entry  has  the  constant 
byte  value  of  zero.  A  single  byte  follows  the  form  field 
containing  the  length  of  the  label's  orintname.  The 
individual  printname  characters  appear  after  the  length 
field.  A  two  byte  field  following  the  orintname  characters 
contains  a  sequentially  generated  integer  value  which  is 
assigned  as  the  label's  internal  label  number.  This  value 
is  used  as  the  target  for  branching  in  the  intermediate 
code.  An  example  of  a  label  declaration  with  its  associated 
symbol  table  entry  is  shown  in  Figure  3. 

b.   Constant  Entries 

The  form  fiela  of  a  constant  symbol  table  entry 
not  only  identifies  the  type  of  entry/  it  also  designates 
the  oarticular  type  of  constant.  The  five  valid  types  of 
constants  are:  unsigned  identifier  (FORM  =  OIH)/  signed 
identifier  (FORM  =  aih)/  integer  (FORM  =  09H),  real  value 
(FORM   =  IIH)/  and  String  constant  (FORM  =  19h),   Each  entry 
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EXAMPLE  LABEL  DECLARATION: 
LABEL   10,  6000; 

SYMBOL  TABLE  ENTRY  FOR  ABOVE  DECLARATION 
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in  the  symDol  table  has  a  unique  three  bit  code  in  its  one 
byte  form  field.  The  three  bit  code  for  constant  entries/ 
for  example/  is  001,  The  remaining  bits  in  the  f-OHM  variable 
describe  the  oarticular  characteristics  of  the  type 
i  n vo 1 ved  . 

Following  the  form  field  of  the  constant  entry 
are  the  orintname  length  field  and  the  printname  characters. 
The  value  of  the  constant  follows  the  printname  characters. 
The  value  field  may  consist  of  another  length  field  and 
printname  characters  in  the  case  of  identifier  and  stnng 
constants/  or  it  may  contain  the  internal  representation  of 
a  constant  number  (two  bytes  for  integer  values  and  eight 
bytes  for  real  values). 

c  .   Type  Entries 

There  are  two  kinds  of  type  entries  that  can  be 
found  in  the  NPS-PASCAL  symbol  table/  a  simple  type  entry  or 
a  type  declaration  entry.  Simple  tyoe  entries  either 
indicate  that  a  basic  type  is  being  assigned/  or  that  a 
defined  complex  tyoe  declaration  is  to  be  evaluated.  In  the 
later  case/  the  simple  type  entry  will  contain  a  pointer  to 
a  type  declaration  entry.  Type  declaration  entries  are 
generated  from  user  defined  types  found  in  the  source 
program.  In  some  cases,  a  chain  of  type  declarations  can  be 
defined.  An  example  of  this  would  be  an  ar  ray  of  the  type 
array  which  is  itself  of  type  integer. 

The  form  field  of  a  simple  type  entry  indicates 
which   basic   type  is  being  entered  or  accessed.   An  integer 
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type  has  the  FORM  value  of  ^2h,  a  real  type  has  the  FORM 
value  of  aAH,  a  character  tyoe  hds  a  FURM  value  of  S^fH,  and 
a  boolean  t-yoe  has  a  FORM  value  of  S'iH.  A  FORM  value  of  7Ah 
indicates  that  a  type  declaration  entry  must  be  accessed  to 
determine  the  complete  tyoe  of  the  entry.  Tne  field 
following  the  form  is  a  one  byte  field  containing  the  length 
of  the  printname/  which  is  followed  by  the  printname 
characters  of  the  tyoe  identifier.  The  last  t«o  bytes 
contain  the  address  of  the  specified  type.  An  example  of  a 
simple  type  entry  is  found  in  Fiqure  4. 

A  tyoe  declaration  entry  is  constructed  for  any 
of  the  seven  different  user  definable  types  in  NPS-PASCAL/ 
consisting  of  scalar  typeS/  subrange  tyoeSf  array  types^ 
record  typeS/  set  typesf  file  tyoes/  and  oointer  types. 
Only  the  scalar  entry  contains  an  accessiole  printname.  The 
rest  of  tne  entries  must  be  accessed  via  a  pointer  fiela 
found  in  other  entries.  The  format  of  these  type 
declaration  entries  is  found  in  Tables  1  through  7. 

d,   Variaole  tntries 

The  form  field  of  the  variable  entry  contains  a 
value  w h i c n  describes  the  type  of  tne  variable.  The  values 
of  the  FORM  and  their  associated  tyoes  are  shown  in  Table  8, 
Following  the  form  field  are  the  fields  which  contain  the 
variable  identifier's  orintname  length  and  printname 
characters.  A  two  byte  field  which  contains  the  address  of 
the  variable's  starting  address  in  memory  appears  after  the 
printname   Characters.    This   address   is  a  relative  offset 
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Simple  Type  Entry  Example: 


MEMORY 
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3407H 
3406H 
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Scalar  Syabol  Table  Entry  Poraat 
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Subrange  Synbol  Table  Entry  Foraat 
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Array  Symbol  Table  Entry  Poraat 
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ARRAY  SYMBOL  TABLE  ENTRY  FORMAT 
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Set  Symbol  Table  Entry  Format 
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Pointer  Symbol  Table  Entry  Foraat 


Byte  Number 
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Record  Syabol  Table  Entry  Foraat 
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Record  Fixed  Field  Symbol  "^able  Entry  Format 
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frorr  the  Dase  of  the  variable  area  assigned  by  the 
translator.  The  length  of  the  variable  is  determined  cy  the 
variable's  tyoe.  The  compiler  keeos  a  count  of  the  total 
amount  of  storage  and  oasses  this  value  to  the  translator  at 
the  completion  of  the  compilation.  The  translator 
subsequently  converts  the  relative  addresses  in  tne 
intermediate  code  to  absolute  addresses  in  the  final  target 
machine  code.  An  example  of  a  variable  entry  is  given  in 
Figure  5  . 

e.   Procedure  and  Function  Entries 

Although  the  grammar  of  NPS-PASCAL  supports 
procedures  and  functions^  the  construction  of  their  symbol 
table  entry  was  not  implemented.  Their  implementation, 
however,  would  parallel  the  same  format  of  all  the  other 
entries  in  the  symbol  table.  The  FOWM  values  of  U^H,  and 
05H  v^ere  reserved  for  this  purpose. 

4.   Symbol  Table  Construction  and  Access 

Several  standard  construction  and  access 
procedures  were  develooed  for  the  manipulation  of  the  symbol 
table.  The  procedure  ENTERSVARSID  is  used  by  all  routines 
which  construct  a  symbol  table  entry  containing  an 
accessible  printname.  This  procedure  calls  ENTERSLINKS  to 
assign  the  collision  and  previous  symbol  table  entry  address 
fields.  The  procedure  ENTERiPNJID  is  then  called  to  enter 
the  printname  length  and  printname  characters.  ENTERSVARSID 
is  called  with  the  value  of  FORNi  to  be  included  with  the 
symbol.    The   calling   routines  must  subspguently  enter  the 
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The  Form  Field  of  Variable  Entries 
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Variable  Entry  Example 


VAR   ABC  :  Boolean; 

^  SYMBOL  TABLE 
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additional  aescriotive  fields  for  the  oarticular  entry  under 
construction. 

Symbol  table  access  is  accomplished  through  the  use 
of  the  stanaard  lookup  orocedures/  and  pointers  contained 
within  entries.  Ihe  procedure  LUOKUPJUNL Y  can  oe  called 
with  the  a'idress  of  a  printname  as  a  paran-eter.  The 
procedure  calls  CHtCKJPR InTSNAME  to  compare  the  symbol  table 
entry's  printname  with  that  of  the  parameter.  The  hashtable 
index  of  the  parameter  is  used  along  with  the  symbol  table 
collision  fields  to  access  the  correct  entries  in  the  table. 
The  procedure  LOOKUP$FN$ID  was  designed  to  accomplish  the 
same  task  as  LOOKUPSOHLY  with  the  additional  feature  of 
checking  the  form  field  of  the  entry  with  a  second 
parameter.  If  either  procedure  finds  a  match  in  the  symbol 
table  the  global  variable  LOOKUPiADOK  is  set  to  the  location 
of  the  starting  address  in  the  symbol  table  of  the  matcned 
entry^  and  the  value  TRUE  is  returned  to  the  calling 
rout  i  n  e . 

5 .   Parser 

The  Parser  was  taken  from  the  ALGOL-M  compiler  [51/ 
a  table  driven  pushdown  automaton  with  parse  tables 
generated  using  the  LALR(k)  parser  generator  llbl.  It 
receives  tokens  from  the  scanner  and  analyzes  them  to 
determine  if  they  are  oart  of  the  IMPS-PASCAL  grammar.  If 
the  parser  accepts  a  tokens  one  of  the  following  two  actions 
is  taken:  it  may  save  the  token  and  continue  to  reouest 
tokens   for   the   lookahead   state/   or  it  may  recognize  the 
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riqht  part  of  a  valid  production  and  apply  the  production 
state  causing  a  reauction  to  take  place.  If  the  parser 
deterrmnes  that  the  token  received  does  not  constitute  a 
valid  right  part  of  any  production  in  the  f\i  PS-PASCAL 
grammar ,  a  syntax  error  will  be  printed  at  the  console  and 
the  Rc.C(JVtf^  oroceaure  is  called. 

When  the  RECOVER  procedure  is  called/  the  parser 
backs  UP  a  state  ana  attemgts  to  continue  parsing  from  that 
state.  If  this  fails^  the  oarser  will  continue  to  backup 
until  the  end  of  the  currently  oending  reduction  is 
encountered.  At  that  point  the  invalid  tokens  are  rejected 
and  an  attempt  to  parse  the  next  token  is  made.  This  action 
continues  until  an  acceptable  token  is  found. 

The  major  data  structures  in  the  parser  are  the  LALR 
(1)  parse  taPles  anj  the  parse  stacks.  The  oarse  stacks 
consist  of  a  state  stack  and  a  orintname  character  stack. 
The  orintname  character  stack  contains  the  individual 
characters  of  the  to<ens  passed  by  the  scanner. 

6.   Code  Generation 

The  parser  not  only  verifies  the  syntax  of  the 
source  statements^  but  also  controls  the  generation  of  the 
intermediate  code  by  associating  semantic  actions  with 
production  reductions,  /Vhen  a  reduction  takes  places  the 
SYNTHESIZE  procedure  is  called  with  the  production  number  as 
a  parameter.  The  SYNTHESIZE  procedure  contains  an  extensive 
case  statement  keyed  by  the  production  number  to  perform  the 
appropriate   semantic   action.    The  syntax  of  the  language^ 
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and  the  semantic  actions  for  each  reduction   are   listed   in 
Apoend  i  x  D . 

6.   TRANSLATOR  (JPG  AN  I  Z  A  T  I  (jM 

The  zero-address  machine  code  translator  for  NPS-PASCAL 
is  a  too  down/  modularized,  program  written  in  PL/M  19]  and 
designed  for  easy  mod i f i c a t i on .  Modules  whose  future 
i np 1 emen t a t i on  are  required  for  the  completion  of  a  full 
compiler  were  included  in  a  stub  form  to  indicate  their 
absence  in  the  program.  As  with  any  other  program  executed 
under  the  CP/M  system,  the  translator  is  loaded,  and  starts 
execution  at  address  100  hexadecimal  (lOOH).  Its  input  is 
the  intermediate  file  <filename>.PIiM  generated  and  stored  on 
disk  cy  the  compiler.  The  translator  makes  two  complete 
passes  of  this  file.  The  intermediate  file  contains  one 
byte  numbers  which  represent  either  opcodes  of  the  pseudo 
machine  or  operands  sent  from  the  compiler  to  the 
translator.  The  numerical  value  of  the  opcode  is  used  to 
determine  the  proper  entry  point  into  a  large  case 
statement.  tacn  case  statement  in  the  translator  generates 
the  portions  of  object  code  required  to  produce  the  output 
object  module.  A  simplified  flowchart  of  the  intermediate 
code  handling  routine  is  shown  in  Figure  6. 

On  the  first  pass,  the  translator  determines  the  size 
of  the  Object  module  to  be  generated  by  summing  the  reguired 
number  of  bytes  of  object  code  needed  to  perform  tne 
instructions   of   each  oPCOde  used  in  the  intermediate  file. 
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In  aoditioo/  the  translator's  first  oass  also  determines  the 
relative  addresses  of  all  branching  label  (LBL)  instructions 
which  are  generated  by  the  compiler.  The  label  number 
serves  as  an  index  into  a  label  table/  constructed  t)y  the 
translator^  where  each  label's  relative  location  in  the  code 
area  of  the  object  file  is  stored  and  retrieved.  Label 
number  zero  is  locatea  in  the  two  bytes  following  the  end  of 
the  translator  orogram  in  memory^  denoted  by  .MtMOKY  in 
PL/M/  while  the  location  of  the  nth  label  is  at  bytes  ^*n  + 
.MEi^ORY  and  2*n  *■  .MEMORY  -t-  1.  Thus  the  label  table  is 
limited  only  by  the  size  of  the  unused  Dortion  of  memory  in 
the  host  microcomputer. 

Uoon  reaching  the  end  of  the  first  pass  of  the 
intermeaiate  file/  the  translator  re- 1 n i t i a  1  i zes  the 
program,  closes  and  re-ooens  the  intermeaiate  file/  opens 
the  object  module  file/  and  begins  the  second  phase  of  the 
machine  code  translation. 

After  the  object  file  is  initially  opened/  the 
translator  generates  the  8U60  code  to  load  the  stack  pointer 
(SP)  to  the  maximum  available  address  at  execution  time/ 
which  is  the  last  byte  of  the  CP/M  Transient  Program  Area 
(TPA),  A  branch  instruction  is  then  generatea  to  the  first 
byte  of  the  code  .area. 

The  ODJect  file's  work  area  and  Variable  Storage  Area  is 
located  between  the  branch  instruction  and  the  first  byte  of 
the  code  area.        These  two  areas  are   initialized   with   zero 
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hexadecimal  values.  The  work  area,  sixty  bytes  in  length, 
is  used  for  oerforminq  real  arithmetic  and  as  a  scratch  area 
for  ten^porary  variables.  The  Variable  Storage  Area  is  used 
for  the  storage  of  variables  declared  in  the  source  orogram. 
The  syTibol  table,  which  was  generated  by  the  compiler,  is 
not  availatjle  for  use  by  the  translator.  Therefore,  the 
access  to  variaoles  in  the  Variable  Storage  Area  is 
acco'Tip  1  i  shed  using  the  ooerands  in  the  intermediate  file. 

On  the  second  pass  of  fhe  intermediate  file  object  code 
is  generated  at  address  l^OH  dIus  the  number  of  bytes 
allocated  for  program  variables.  Figure  7  shows  the  object 
file  as  it  appears  at  execution  time  in  the  memory  of  the 
m  i  c  rocompu t  e  r  . 

The  intermediate  file  contains  two  separate  addressing 
schemes.  The  variaole  addresses  are  converted  to  absolute 
addresses  by  adding  the  offset  of  the  work  area  to  each 
address.  The  label  addresses  are  evaluated  on  the  first 
pass  by  counting  the  number  of  bytes  of  object  code  which 
must  be  generated  prior  to  the  apoearance  of  the  label  in 
the  intermediate  file.  On  the  second  pass,  the  translator 
adds  the  offset  of  the  work  area  size  and  the  variable 
allocation  size  to  the  previously  stored  address. 

Two  methods  of  code  generation  are  used  by  the 
translator.  Simple  intermediate  instructions,  which  reguire 
ten  or  less  bytes  of  object  code,  are  generated  in-line. 
Complex   instructions   reguiring   more   than   ten   bytes  are 
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qenerated  once  when  first  encountered,  Subseauent 
occurrences  of  the  same  i  n  f  e  prned  i  a  t  e  file  opcoae  causes  the 
generation  of  a  call  to  the  code  generated  for  the  first 
invocation.  This  results  in  the  generation  of  three  bytes 
of  ODJect  code  for  each  succeding  occurrence. 

There  are  three  routines  used  to  generate  the  object 
module  code.  GENERATE  is  called  for  single  byte  generation* 
GENJFIVE  generates  five  bytes  of  code*  and  GSTEN  generates 
ten  bytes. 

At  the  completion  of  the  second  pass  the  translator 
closes  the  object  mocule  file*  erases  the  intermediate  file 
and  generates  a  completion  message  at  the  console.  If  an 
error  is  detected  curing  translation/  an  error  message  is 
generated  at  the  console  and  the  program  terminates, 

1,   Allocation  of  Storage  Space 

The  opcode  ALL  is  Generated  by  the  compiler  to 
specify  the  number  of  bytes  to  be  allocated  in  the  object 
module's  Variable  Storage  Area,  In  addition,  each  oocode  in 
the  intermediate  file  indicates  the  size  and  type  of  data 
that  is  to  be  operated  upon, 

a ,   Byte  Data 

Byte  cat  a  items  in  the  object  module  have 
two  storage  modes.  The  data  is  stored  in  byte  locations 
when  in  memory.  However,  when  a  byte  value  is  loaded  into 
the  stack,  the  byte  data  is  preceeded  by  a  zero  value  byte 
and  loaded  in  the  stack  in  a  two  byte  format,   A  description 
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of  the  Dyte  storaae  -rodes  is  55hown  in  Figures  B  and  9 .  Byte 
data  values  are  ODerate'i  upon  by  the  translator  in  byte 
format  routines  generated  in  the  object  file.  Byte  data  may 
represent  characters/  numbers/  or  boolean  data. 

b.   Int  eger  Data 

Integers  are  represented  by  two  byte  values 
and  are  stored  in  memory  and  the  system  stack  in  the  same 
format.  The  high  order  byte  is  stored  first  followed  by  the 
low  order  byte  of  the  integer  number.  The  storage  of 
inteaer  numbers  in  memory  and  the  stack  is  shown  in  Figures 
8  and  9,  The  storage  follows  the  processing  reauirements  of 
the  *30flO  Microprocessor  181  to  complete  moves  of  data  from 
memory  or  the  stack  into  the  processor  double  byte 
registers.  ^n  example  of  the  POP  and  PUSH  operation  is 
shown  in  Fiaure  10.  Integers  are  representea  in  two's 
cofT>olement  form.  They  may  take  on  values  from  -3b/768  to 
+36,767.  The  high  oroer  bit  of  the  integer  representation 
is  the  sign  bit.  A  zero  hiah  order  bit  indicates  a  positive 
integer  value  and  a  one  indicates  a  negative  value. 

c  .   Oec  i  ma  1  Data 

Decimals  in  the  NPS-PASCAL  compiler  are 
represented  in  binary  coded  decimal  (BCD)  format.  hvery 
decimal  number  is  represented  by  i  ^  digits  and  is  stored  in 
eiaht  contiguous  bytes.  The  first  byte*  located  at  the 
lowest  memory  address  location,  contains  the  sign  of  the 
number  along  with  the  sign  and  maanituae  of  the  exponent. 
Succeeding  bytes  represent  two   decimal   digits.    The   byte 
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closest  to  the  exoonent  byte  represents  the  last  two  digits 
of  the  numoer  while  the  last  Dvte  contains  the  first  two 
diqits  of  the  number.  Figure  11  shows  a  BCD  number  stored 
in  Tiemory. 

The  sign  information  byte  uses  the  high 
order  bit  to  indicate  the  sign  of  the  number.  A  high  order 
one  bit  indicates  a  negative  number  while  a  zero  bit 
represents  a  positive  number.  The  remaining  seven  bits 
represent  the  exoonent  and  its  siqn»  with  a  bias  of  6^. 
Values  larger  than  b^  represent  a  biased  positive  exponents 
while  the  values  less  than  6*^  reoresent  exponents  of 
negative  sign  with  a  result  equal  to  the  difference  between 
64  and  the  value.  This  reference  point  allows  a  range  of 
exDonent  values  from  -64  to  +63.  The  decimal  noint  of  the 
number  is  always  assumed  to  be  oefore  the  first  digit. 

d.   String  Data 

Strings  in  NPS-PASCAL  are  stored  in  memory 
sequentially.  The  first  byte  located  at  the  starting 
address  location  inaicates  the  length  of  tne  string.  The 
string  of  ASCII  characters  that  follow  the  length  byte  is 
arbitrarily  limited  to  80  characters/  which  is  the  length  of 
an  output  line  to  the  console. 

i  ,       Arithmetic  0 Derations 

a  ,   Log  i  c  a  1 s 

Loqical  ooerations  or  boolean  operations  act 
on  byte  values  of  zero  and  one  only.   A  zero  value  indicates 
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a  false  while  a  non-zero  value  indicates  true.  Logical 
operations  requirina  co;nparison  between  two  elements  return 
the  result  of  the  operation  in  the  form  of  a  true  or  false 
value.  Logical  operations  are  also  performed  using  boolean 
values  to  determine  loaical  unions^  disjunctions^  or 
comp I emen t  s . 

b  ,   Int  ege  r s 

Operations  with  integers  are 
straightforward.  Both  integers  are  removed  from  the  stack 
and  placed  in  double  byte  registers  in  the  8080 
microprocessor  where  the  requested  operation  is  carried  out. 
Operations  with  integers  include  addition^  subtractionr 
multiplication^  aivision,  loaical  comparisons^  and 
transformations  to  bCD  format.  Except  for  transformations/ 
all  results  of  integer  ooerations  are  returned  to  the  stack 
in  the  two  bvte  integer  format. 

c .   Dec  i  ma  1 s 

Arithmetic  operations  with  BCD  numbers  are 
more  complex  than  with  integers.  However/  the  8080 
microprocessor  oroviaes  the  use  of  the  DAA  operator  which 
simplifies  the  addition  operation.  BCD  numbers  and 
temporary  results  are  stored  in  the  work  area  during  all 
real  operations.  Calculations  are  carried  out  by  moving 
decimal  number  pairs  into  the  8080  registers.  The  required 
operation  is  aopliea  reoeatedly  to  successive  bytes  until 
completion.  The  resulting  value  of  the  operation  is 
returned   to   the   N PS-PASCAL   stack   in   its  eight  byte  BCD 
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f o  rma t  . 

vSince  the  default  oosition  of  the  decimal 
Doint  in  a  BCD  number  is  assumed  to  exist  before  the  first 
digit,  all  operations  must  left  justify  each  result.  The 
functions  of  addition,  subtraction,  multiplication,  and 
division  were  not  included  in  the  implementation  at  this 
point.  However,  the  .operations  of  complementing, 
transformation  to  integer  format,  and  some  loaical 
comparisons  were  implemented. 

3,  String  Operations 

String  operations  were  implemented  for  output  and 
for  comparison  to  determine  logical  eguality  or  inequality. 
Comparisons  take  place  either  immediately  between  a  string 
passed  in  the  intermediate  file  and  a  string  in  memory  or 
between  two  strings  located  in  memory.  f^esults  of  the 
comparison  are  returned  to  the  stac<  in  boolean  form. 

4 .  I npu t  -  Output 

Input  as  well  as  output  is  done  interactively 
through  the  console.  The  translator  reads  input  numbers 
from  the  console  and  transforms  them  into  the  internal  form 
of  either  an  integer  or  a  BCD  number.  Similarly,  the  work 
area  is  used  to  convert  numoers  into  a  printable  form  for 
output  to  the  console.  The  routine  WRITES STRNG  is  used  to 
generate  the  object  code  which  performs  all  output 
operations,  while  the  routines  READiiNT  and  REAOSBCD  are 
used  to  perform  all  inout  operations. 
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5.   NPS-PASCAL  Pseudo  Ooerators 

The  Dseudo  code  used  in   NP3-PASCAL,   which   differs 
from  the  PASCAL-<P>  code  113),  is  listed  below. 

a.  Literal  Data  References 

LITA:  (Literal  Address).  This  operator 
generates  8080  code  to  place  the  following  two  byte  integer 
value  on  the  stack, 

b.  Allocation  Operators 

ALL:  (Allocate).  This  operator  generates 
code  that  initializes  the  number  of  bytes  of  storage 
reouired  for  the  VSA.  The  size  of  the  VSA  is  provided  in 
the  two  byte  ooerand. 

L8L:  (Label),  This  operator  is  used  on  the 
first  oass  of  the  translator  to  calculate  the  aadress  of  the 
label  in  the  code  area  and  save  it  in  the  label  table  using 
the  next  two  byte  integer  number  as  the  label  number. 

LDIB:  (Load  Immediate  BCD).  This  operator 
generates  code  to  place  the  following  eight  bytes  on  the 
s  t  a  c  ■<  , 

LDII:  (Load  Immediate  Integer),  This 
operator  generates  code  to  place  the  following  two  bytes  on 
the  stack, 

LUD:  (Load  Byte).  This  ooerator  generates 
code  to  move  the  top  two  bytes  on  the  stack  into  the  8080  HL 
register.  The  byte  is  then  moved  from  its  location  in 
memory  to  the  Stack  oreceeded  by  a  high  order  zero  byte. 

LODB:   (Load  BCD).   This  ooerator   generates 
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code  to  move  the  top  two  bytes  on  the  stack  into  the  8080  HL 
register;  it  then  increments  the  register  by  eight  and  moves 
eight  bytes  in  decending  order  from  memory  onto  the  stack. 

LODI:  (Load  Integer),  This  operator 
generates  code  to  move  the  top  two  bytes  on  the  stack  into 
the  8080  HL  register;  it  then  moves  two  bytes  from  that 
location  onto  the  stack, 

c.   Arithmetic  Operators 

CNV8:  (Convert  BCD),  This  operator 
generates  code  to  replace  the  BCD  value  of  the  top  eight 
bytes  in  the  stack  by  a  two  byte  integer  value.  Conversion 
of  the  number  takes  place  in  the  work  area. 

CNVl:  (Convert  Integer).  This  operator 
generates  coae  to  replace  the  two  byte  integer  value  on  top 
of  the  stac*c  by  its  eight  byte  BCD  value.  Conversion  of  the 
number  tanes  place  in  the  work  ares, 

CNAI:  (Convert  Integer  Preceeding  Address), 
This  operator  generates  coae  to  move  the  top  two  bytes  from 
the  top  of  the  stack  into  a  save  area  then  to  move  the 
following  integer  into  the  work  area.  Code  is  then 
generated  to  convert  the  integer  to  a  BCD  eight  byte  format. 
The  resulting  BCD  number  is  then  returned  to  the  stack 
followed  by  the  two  bytes  from  the  save  area. 

CN2I:  (Convert  Integer  Preceeding  BCD). 
This  operator  generates  code  to  move  the  two  bytes  from  the 
top  of  the  stack  into  a  save  area  then  the  following  BCD 
number   into   the   work  area.  Code   is   then  generated  to 


5a 


convert  the  BCD  number  to  an  integer  number.  The  resulting 
integer  number  is  then  returned  to  the  stac<  followea  by  the 
two  bytes  from  the  save  area. 

ADD9:  (Add  BCD).  This  operator  generates 
code  to  move  the  two  9C0  values  from  the  top  of  the  stack 
into  the  work  area  where  the  sum  of  the  two  numbers  is 
calculated  and  returned  to  the  stack  in  BCD  format  (not 
implemented). 

ADDI:  (Add  Integer).  This  operator 
generates  code  to  move  the  two  integer  values  on  the  toP  of 
the  stack  to  the  8080  registers  where  the  sum  of  the  two 
numbers  is  calculated  and  returned  to  the  too  of  the  stack. 

SUBB:  (Subtract  BCD).  This  operator 
generates  code  to  move  two  BCD  values  from  the  top  of  the 
stack  into  the  work  area  where  the  first  BCD  number  is 
subtracted  from  the  second  BCD  number.  The  resulting  BCD 
number  is  returned  to  the  top  of  the  stack  (not 
i  mo  1 emen  ted), 

SUBI:  (Subtract  Integer).  This  operator 
generates  code  to  move  the  two  integer  values  on  too  of  the 
stack  to  the  8080  registers  where  the  first  integer  is 
subtracted  from  the  second  integer.  The  resulting  integer 
number  is  returned  to  the  stack. 

MULB:  (Multiply  BCD).  This  operator 
generates  code  to  move  two  BCD  values  from  the  top  of  the 
stack  into  the  work  area  where  their  oroduct  is  calculated. 
The  resulting  PCD  number  is  returned  to  the  too  of  the  stack 
(not  i mc 1 emen t ed )  . 
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MULI:  (Multiply  Integer).  This  operator 
generates  code  to  move  the  two  integer  values  on  top  of  the 
stacK  to  the  working  area  where  the  product  is  calculated. 
The  resulting  inteaer  number  is  returned  to  the  top  of  the 
stack. 

DIV8:  (Divide  BCD).  This  operator 
generates  code  to  move  two  BCD  values  from  the  top  of  the 
stack  into  the  work  rirea  where  the  second  BCD  is  divided  by 
the  first  BCD  number.  The  guotient  is  returned  to  the  top 
of  the  stack  in  BCD  format  (not  implemented). 

OIVI:  (Divide  Integer).  This  operator 
generates  code  to  move  the  two  integer  values  at  the  too  of 
the  stack  to  the  work  area  where  the  second  integer  is 
divided  by  the  first  integer.  The  guotient  is  returned  to 
the  too  of  the  stack  in  integer  format. 

LSS6;  (Less  Than  BCD).  This  operator 
generates  code  to  move  the  two  BCD  values  at  the  too  of  the 
stack  to  tne  work  area  where  the  two  numbers  are  comparea. 
If  the  second  BCD  number  is  smaller  than  the  first  BCD 
number/  a  one  is  returned  to  the  stack.  Otherwise  a  zero 
is  returned  (not  implemented). 

LSSI:  (Less  Than  Integer).  This  operator 
generates  code  to  move  the  two  integer  values  at  the  top  of 
the  stack  to  the  8080  registers  where  the  two  numbers  are 
compared.  If  the  second  integer  is  smaller  than  the  first 
integer,  a  one  is  returned  to  the  stack.  Otherwise  a  zero 
is  re t  u  rned . 

LEQB:    (Less   Than   or   Eoual   BCD).    This 
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operator  generates  coae  to  move  the  two  values  at  the  top  of 
the  stack  to  the  work  area  where  the  two  numbers  are 
comoarea.  If  the  second  tiCD  number  is  smaller  than,  or 
equal  to»  the  first  BCD  number,  a  one  is  returned  to  the 
stack.    Otherwise  a  zero  is  returned  (not  implemented). 

LEOI:  (Less  Than  or  Eaual  Inteaer).  This 
operator  generates  code  to  move  the  two  integer  values  at 
the  top  of  the  stack  to  the  8080  registers  where  the  two 
numbers  are  compared.  If  the  second  integer  removed  from 
the  stack  is  smaller  than,  or  equal  tO/  the  first  integer  a 
one  is  returned  to  the  stack.   Otherwise  a  zero  is  returned. 

EQLB:  (Equal  to  8CP).  This  operator 
qenerates  code  to  move  the  two  BCD  values  on  top  of  the 
stack  to  the  work  area  where  the  two  numbers  are  compared. 
If  the  two  BCD  numbers  are  equal  a  one  is  returned  to  the 
stacic.   Otherwise  a  zero  is  returned. 

EQLI:  (Egual  to  Inteaer).  This  operator 
generates  code  to  move  the  two  integer  values  at  the  top  of 
the  stack  to  the  8080  registers  where  the  two  numbers  are 
compared.  If  the  two  integers  are  equal  a  one  is  returned 
to  the  stack.   Otherwise  a  zero  is  returned. 

NEQ8:  ('Mot  Equal  to  BCD).  This  operator 
qenerates  code  to  move  the  two  BCD  values  at  the  toP  of  the 
stack  to  the  work  area  where  the  two  numbers  are  compared. 
If  the  numbers  are  not  equal  a  one  is  returned  to  the  stack. 
Otherwise  a  zero  is  returned. 

NEQI:  (Not  Equal  to  Integer).  This 
operator   generates   code   to  move  the  two  integer  values:  at 
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the  too  of  the  stack  to  the  8080  registers  where  the  two 
numbers  are  coTiDared.  If  the  numbers  are  not  equal  a  one  is 
returned  to  the  stack.   Otherwise  a  zero  is  returneJ. 

GEQB:  (Greater  Than  or  Eaua)  BCD).  This 
ooerator  generates  code  to  move  the  two  bCU  values  at  the 
top  of  the  stack  to  the  wor-k  area  where  the  two  numoers  are 
compared.  If  the  second  number  is  greater  than  or  equal  to 
the  first  number  a  one  is  returned  to  the  stack.  Otherwise 
a  zero  is  returned. 

GEQI:  (Greater  Than  or  Equal  Integer). 
This  operator  generates  code  to  move  the  two  integer  values 
at  the  too  of  the  stack  to  the  8080  registers  where  the  two 
numbers  are  comoared.  If  the  second  number  removed  from  the 
stac<  is  greater  than^  or  egual  to/  the  first  integer  a  one 
is  returned  to  the  stack.   Otherwise  a  zero  is  returned. 

GRT8:  (Greater  Than  BCD).  This  operator 
generates  code  to  move  the  two  BCD  values  at  the  top  of  the 
stack  to  the  work  area  where  the  two  numbers  are  compared. 
If  the  second  BCD  number  is  greater  than  the  first  BCD 
number  a  one  is  returned  to  the  stack.  Otherwise  a  zero  is 
returned  (not  implemented). 

GRTI:  (Greater  Than  Integer).  This 
operator  qenerates  code  to  move  the  two  integer  numbers  at 
the  too  of  the  stack  to  the  8080  registers  where  they  are 
comoared.  If  the  second  number  is  greater  than  the  first 
integer  a  one  is  returned  to  the  stack.  Otherwise  a  zero  is 
returneg. 

NEGB:     (Negate    BCD).     This     operator 
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generates  code  to  move  the  too  two  bytes  on  the  stack  to  the 
8080  registers  where  it  comDlements  the  sign  bit  of  the  BCD 
sign  byte  then  returns  the  two  bytes  to  the  stack. 

NEGI:  (Negate  Integer),  This  operator 
generates  code  to  rnove  the  integer  number  from  the  stack  to 
the  8080  reqistersf  comolements  thp  number  to  its  negative 
number  and  returns  it  to  the  stack, 

COMB;  (Comolement  BCD),  This  operator 
generates  code  to  move  the  too  eight  byte  BCD  number  from 
the  stack  into  the  work  area/  finds  tne  nine's  complement  of 
the  number  and  returns  it  to  the  stack. 

COMI:  (Complement  Integer).  This  operator 
generates  code  to  move  the  too  two  byte  integer  number  into 
the  8080  registers/  finds  the  two's  complement  of  the  number 
and  returns  the  value  to  the  stack. 

d.   Boolean  Operators 

NOT:  (Boolean  Not).  This  operator 
generates  code  to  move  the  two  bvtes  at  the  top  of  the  stack 
into  the  8  0  80  registers  and  compares  the  low  order  byte.  If 
the  byte  is  zero  it  returns  a  two  byte  value  of  one  to  the 
stack.  If  the  byte  is  one  it  returns  a  two  byte  value  of 
zero . 

AND;  (Boolean  And).  This  operator 
generates  code  to  move  the  next  two  integer  numbers  into  the 
8080  registers  for  logical  AND  comparison  of  their  low  order 
bytes.  If  the  relation  is  true/  a  two  byte  value  of  one  is 
returned  to  the  stacK.   If  the  relation  is  not   true   a   two 
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byte  value  of  zero  is  returned  to  the  stacW. 

60R:  (Boolean  Or).  This  operator  generates 
code  to  move  the  next  two  integer  numbers  into  the  8080 
reoisters  for  loaical  OR  comparison  of  their  low  oraer 
bytes.  If  the  relation  is  true*  a  two  byte  value  of  one  is 
returned  to  the  stack.  If  the  relation  is  not  true,  a  two 
byte  value  of  zero  is  returned  to  the  stack. 

e.   String  Operators 

EQLS:  (Eoual  String).  This  operator 
generates  code  to  compare  a  strina  whose  length  is  given  by 
the  following  Dyte.  It  moves  the  two  bytes  at  the  top  of 
the  stack  into  the  8080  ML  register  ana  compares  the  string 
one  byte  at  the  time  for  eauality.  If  the  string  in  the 
snecified  memorv  location  is  eaual  to  the  string  in  the 
i n t e rmeo i a t e  file/  a  one  is  returned  to  the  stack. 
Otherwise  a  zero  is  returned  (not  implemented). 

MEQS:  (Not  Egua1  String).  This  operator 
generates  code  to  comoare  a  strina  whose  length  is  given  by 
the  following  bvte.  It  moves  the  two  bytes  at  the  top  of 
the  stack  into  the  8080  HL  register  and  compares  the  strings 
for  eauality.  If  the  string  in  the  specified  memory 
location  is  eoual  to  the  string  in  the  intermediate  file*  a 
zero  is  returned  to  the  stack.  Otherwise  a  one  is  returned 
(not  implemented). 
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f  .   Stack  Ooe  ra t  o  rs 

DCR6:  (Decrement  Stack  BCD).  This  operator 
generates  code  to  decrement  the  si?e  of  the  stack  by  eight 
bytes. 

DCRI:  (Decrement  Stack  Integer).  This 
operator  generates  code  to  decrement  the  size  of  the  stack 
by  two  bytes. 

DCRI:  (Decrement  Stack  Byte).  This 
operator  generates  code  to  decrement  the  size  of  the  stack 
bytwobytes. 

g.   Program  Control  Operators 

BRL:  (Branch  to  Label).  This  operator 
calculates  the  label  address  in  the  laoel  table  using  the 
next  two  byte  label  number  and  moves  the  coaecount  storea  at 
the  laoel  table  adaress  and  adds  to  it  the  address  of  the 
start  of  the  code  area.  It  then  generates  code  to  branch  to 
the  calculated  address. 

BCL:  (Branch  Conditional  Label).  This 
operator  calculates  the  branching  address  in  the  same  manner 
as  the  BRL  coae  above.  It  then  generates  the  code  to  move 
the  two  bytes  on  top  of  the  stack  to  the  8080  registers  to 
check  the  condition.  If  the  low  order  byte  removed  from  the 
stack  is  a  one >  the  branching  instruction  is  executed.  If 
the  low  order  byte  is  a  zero  the  program  continues  without 
branch  i  ng . 

ENDP;  (End  of  Program).  At  the  end  of  the 
first   oass   of   the   translator  this  code  reinitializes  the 
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rroqram,  closes  the  intermediate  file*  and  sets  the  second 
pass  condition  to  true.  On  the  second  pass  this  opcode 
generates  code  to  terminate  the  object  code  file  and 
terminates  compilation. 

h.   Store  Ooerators 

ST08:  (Store  BCD).  This  operator  generates 
code  to  move  the  two  Dytes  at  the  ton  the  stac><  into  the 
8080  HI.  register  then  moves  the  next  eight  bytes  from  the 
stack  to  memory  start ina  at  the  address  indicated  by  the  HL 
register.  The  value  of  the  BCD  number  is  oreserved  in  the 
stack  by  incrementing  the  stack  pointer  by  eight. 

STOi:  (Store  Integer).  Tnis  operator 
generates  code  to  move  the  two  bytes  at  the  too  of  the  stack 
into  the  8060  HL  register  then  moves  the  next  two  bytes  from 
the  stac<  to  memory  starting  at  the  address  indicated  by  the 
HL  reaister.  The  value  of  the  integer  number  is  preserved 
in  the  stack  by  incrementing  the  stack  pointer  by  two. 

STOI:  (Store  Ryte).  This  operator 
generates  code  to  move  the  two  bytes  at  the  top  of  the  stack 
into  the  8080  HL  register,  then  moves  the  next  byte  from  the 
stack  to  memory  at  the  address  indicated  by  the  HL  register. 
The  value  of  the  oyte  value  is  oreserved  in  the  stack  by 
incrementing  trie  stack  pointer  by  two. 

STDB:  (Store  Oestruct  BCD).  This  operator 
generates  code  to  move  the  two  bytes  at  the  top  of  the  stac< 
into  the  808  0  HL  reaister  then  moves  the  next  eight  bytes 
from   the  stack  to  memory  at  the  address  indicated  by  the  HL 
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register, 

STOI:  (btore  Oestruct  Integer).  This 
operator  generates  code  to  move  the  two  bytes  at  the  top  of 
the  stack  into  the  6  08  0  HL  register  then  moves  the  next  two 
bytes  from  the  stack  to  memory  starting  at  the  address 
indicated  by  the  HL  register. 

STO:  (Store  Destruct  Byte).  This  operator 
generates  code  to  move  the  two  bytes  at  the  top  of  the  stack 
into  the  8080  HL  register  then  moves  the  next  byte  from  the 
stack  to  memory  starting  at  the  address  indicated  by  the  HL 
reg  i  s t  e  r  . 

i.   Input  -  Output  Ooerators 

RDV8:  (Read  Variable  BCD).  This  operator 
generates  code  to  reao  a  BCD  number  from  the  console/  change 
it  into  its  acceptaole  storage  form,  and  place  the  eight 
byte  internal  form  on  top  of  the  stack  (not  implemented). 

RDvI:  (Read  Variable  Integer).  This 
operator  generates  code  to  read  an  integer  number  from  the 
console^  change  it  into  its  acceptable  storage  form,  and 
place  the  two  byte  number  on  top  of  the  stack  (not 
i  mp 1 ement  ed ) . 

RDVS:  (Read  Variable  String).  This 
operator  generates  code  to  read  a  string  variable  from  the 
console  and  stores  it  at  a  location  in  memory  indicated  by 
the  two  top  bytes  on  the  stack  (not  implemented). 

WRVB:  (/Jrite  Variable  BCD).  This  operator 
Generates   code  to  move  the  eiaht  byte  bCD  number  at  the  top 
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o^  the  stack  into  the  wor<  area,  changes  the  numoer  into  its 
printable  form  and  prints  the  number  to  the  console. 

v^RMl:  (Write   Variable    IntegerJ.     This 

operator  generates  code  to  move  an  integer  number  into  the 
work  area,  change  the  number  into  its  printable  form  and 
print  tne  number  at  the  console. 

WRVS:  (Write  Variable  String).  This 
operator  generates  code  to  print  a  string  variable  at  the 
console  egual  in  length  to  the  next  one  byte  integer.  The 
string  variable  follows  the  size  byte. 

OUMP:  (Start  New  Output  Line).  This 
operator  generates  code  to  send  a  carriage  return  and  line 
feed  to  the  console, 

j.   Routine  Operators 

PRO:  (Procedure  Call).  This  operator 
generates  coae  to  save  the  oresent  address  loaded  in  the 
program  counter  (PC)  register  and  loads  the  PC  register  with 
the  address  contained  in  the  next  two  bytes  (not 
i  mp 1 emen t  ed) , 

RTN:  (Return  From  Procedure).  This 
operator  generates  code  to  retrieve  the  address  stored  by 
the  previously  executed  procedure  and  loads  the  PC  register 
to  continue  the  program  at  this  location  (not  i mo  1 emen t ed ) , 

SAVP:  (Save  Parameters).  This  operator 
generates  code  to  save  the  present  value  of  the  parameters 
in  the  next  available  area  above  the  end  of  the  object  code 
(not  implemented). 
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UNSP:  (Unsave  Parameters).  This  operator 
generates  code  to  return  the  parameter  values  from  the  area 
above  the  object  code  (not  implemented). 
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IV.   CONCLUSIONS  AMD  RECOMMENDATIONS 


The  N PS-PASCAL  project  described  here  is  the  first  stage 
of  a  full  PASCAL  i-nplementation  for  Intel  8  0  80  teased 
microcomputers.  Although  incomplete*  the  compiler 
structures  are  essentially  intact*  ana  the  code  generator  is 
f ormu 1  a t  ed . 

Several  features  of  the  PASCAL  language  have  not  been 
imolemented  and  are  indicated  in  the  program  listings.  The 
structure  of  the  heap*  which  is  reguired  for  recursive 
procedures  and  functions*  as  well  as  record  manipulations* 
has  not  been  designed  nor  implemented.  Integrated  program 
testing,  including  timino  tests*  will  also  oe  necessary  to 
determine  the  correctness  and  efficiency  of  the  overall 
system.  Enhancements*  such  as  formatted  I/O*  external 
subroutine  library  access*  and  run-time  debugging*  must  also 
be  aesigned  and  implemented.  The  structure  of  the  symbol 
table  should  make  run-time  debugging  relatively  easy. 
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APPENDIX  A  -  COMPILER  ERROR  MESSAGES 


DE 
TO 

EE 
IE 
IS 

IT 

lA 

NP 
IC 

IE 

ES 
IR 

LS 

DC 
DT 
TI 
AN 


Disk  error  :  Recomoile. 

SyfTibol  table  overflow  :  Reduce  number 
of  dec  1 aret  i  ons . 

Exoonent  size  error  :  See  user  manual. 

Integer  size  error  :  See  user  manual. 

Invalid  subrange  error  :  Check  type  and 
limits  of  declared  subrange. 

Invalid  tyoe  error  :  Array  component  tyoe 
specification  invalid. 

Invalid  array    index  :  Array  index  types 
must  be  scalar  -  INTEGER  or  REAL  types  are 
i  n  V  a  1  id. 

I^Jo  production  :  Syntax  error  in  source  line. 

Invalid  constant  variable  :  Constant  entry 
in  symbol  table  invalid  -  probably  due  to  a 
priorerror. 

Invalid  expression  type  :  The  types  of 
variables  usee  in  an  expression  are 
incompatible. 

Expression  stack  overflow  :  Simplify  program. 

Invalid  read  variable  :  Only  INTEGER  or  REAL 
values  can  be  read. 

Label  syntax  error  :  All  labels  must  be 
i  nt  ege  rs  . 

Duplicate  constant  name  :  Constant  identifiers 
must  be  un  i  gue  . 

Duplicate  type  name  :  Type  identifiers  must  be 
un  i  gue . 

Invalid  type  identifier  :  Type  identifier  not 
previously  declared. 

Array  nest  overflow  :  Simplify  declaration. 
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AD 


Array  dimension  stack  overflow  :  Simplify 
array  declaration. 


IV 


Variant  stack  overflow  :  Reduce  the  number 
of  variant  cases. 


RN 


Record  field  stack  overflow  :  Reduce  t^^e  number 
of  fields  spec  i  f  i  erj. 


VN 


Variable  declaration  stack  overflow  :  Reduce 
the  number  of  variables  declared  oer  line. 


UL 


Undefined  label  error  :  Label  not  declared 
in  label  statement. 


AT 


CE 


UO 


Assignment  type  error  :  Type  of  expression  not 
compatible  with  assignment  variable  type. 

Invalid  expression  :  The  variable  types  within 
the  expression  are    not  compatible. 

Invalid  unary  operator  :  Variable  type  must  be 
INTEGER,  REAL,  or  subrange  of  INTEGER. 


SO 
VO 


State  stack  overflow  :  Simplify  program. 

Variable  stack  overflow  :  Reduce  the  length  of 
variable  printnames. 
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If  statement  stack  overflow  :  Simplify  program. 
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APPENDIX  B  -  TRANSLATOR  MESSAGES 


10 
EO 
EU 
DZ 
II 


MESSAGES 
Disk  file  close  error. 
Disk  file  create  error. 
Disk  file  write  error. 
No  internal  file  found. 
Integer  over f 1 ow . 
ExDonent  overflow. 
Exponent  underflow. 
Division  by  zero  attempted. 
Invalid  Console  Tnout 

End  of  compilation.  Mo  proaram  errors. 
Compilation  terminated  due  to  error(s) 
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APPENDIX  C  NPS-PASCAL  LANGUAGE  MANUAL 


This  section  describes  the  various  elements  of  the 
NPS-PASCAL  language.   The  format  of  the  element  will 
be  shown/  followed  bv  a  descr;iption  and  examoles  of 
its  use.   The  following  notation  is  used: 

Braces  {}     indicate  an  optional  entry. 

A  vertical  bar  |  indicates  alternate  choices*  one  of 

which  must  appear. 

Reserved  words  are  indicated  by  capital  letters. 

Reserved  words  ana  other  special  symbols  must  appear 

as  shown  . 

Items  aooearing  in  small  letters  are  elements  of  the 

language  which  are    defined  and  explained  elsewhere 

in  the  language  manual. 
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arithmetic  expression 


ELEMENT: 


arithmetic  expression 


FORMAT: 


i  n t  eger I  dec  i  ma  1 

variable 

{(}     arithmetic  expression   binary  operator 

arithmetic  expression  {)> 

{(}  unary  operator   arithmetic  expression  {)> 


DESCRIPTION: 


Arithmetic  expressions  consist  of  basic  data  elements 
combined  with  arithmetic  operators  in  algebraic 
notation. 


EXAMPLE: 


(A  f  8) 
-A 

C  +  13. 6 
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Array  Dec  1  a  rat  i  on 

ELEMENT: 

Array  Dec  1 arat  i  on 

FORMAT: 

VAR  identifier:  ARRAY  (*  i ndex-t ype-s t r i ng  *) 

OF  componen t - t yoe 
VAR  identifier:  ARRAY  (*  i ndex-t yoe-st r i ng 

if     index-type-string}  *) 
OF  c opponent -t ype 

DESCRIPTION: 

Array  types  consist  of  a  fixed  nutiber  of  declared 
components  ;  where  all  the  components  are  of  the  same 
type.  Each  component  of  the  array  variable  can  be 
directly  accessed  by  the  name  of  the  array  variable 
followed  by  its  index  location  in  the  array  enclosed 
in  the  (*  notation.   See  assignment  statement. 


EXAMPLE: 


VAR  temperature:  ARRAY  (*  1..10  *)  OF  REAL; 
VAR  grades:  ARRAY  (*  1..5/2..8  *)  OF  INTEGER; 
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assignment  statement 


ELEMENT: 

assignment  statement 

FOKMAT: 

variable  :=  expression 

DESCRIPTION: 


Assignment  statements  indicate  a  value  to  be  assigned 
to  a  variable  or  a  value  to  replace  the  present  value 
of  a  variable.  The  symbol  :=  is  the  assignment 
operator  and  must  not  be  confused  with  the  relational 
operator  =  indicatina  eauality.  The  resulting  value 
of  the  expression  on  the  right  side  of  the  assignment 
statement  must  be  consistent  with  the  type  of  variable 
Deing  assigned  the  new  value.  The  only  exception  is 
that  INTEGER  expression  types  will  be  converted  to 
REAL  in  the  assignment  to  a  real  variable. 


EXAMPLE: 


X  :=  o; 

t empera t ure ( *  2  *)  := 

y  :=  (15  oiv  a)  *  2; 


103.7; 
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balanced  statement 

ELEMENT: 

balanced  statement 

FORMAT: 

s  i  mpl e  Stat  ement 

IF  {(}  boolean-expression  {)}  THEN  balanced-statement 
ELSE  balanced-statement 

DESCRIPTION: 

Simple  statements  are  statements  of  which  no  part 
constitutes  another  statement;  therefore*  it  is 
considered  a  balanced  statement.  The  IF  conditional 
statement  has  parts  constituting  other  statements. 
However,  if  the  IF  clause  is  balanced  by  an  ELSE 
balanced-statement  the  statement  is  balanced. 

EXAMPLE: 

IF  X  >  0  THEN  flag  :=  TRUE;  ELSE  a  :=  2; 
X    :=  (y  *  10)  /  b; 

aoto  30  0; 
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b  1  ock 


ELEMENT: 

bl  ock 

DESCRIPTION: 


The  block  preceeded  by  a  prograrn-headi  ng  forms  the 
PASCAL  program.  Similarlv/  the  block  preceeded  by  a 
procedure-heading  or  a  function-heading  forms  parts  of 
the  Procedure  and  Function  Declaration  Part.  The  block 
consists  of  Label  Declaration  Part/  Constant 
Definition    Part  ,  Type   Definition   Part/   Variable 

Declaration  Part/  Procedure  and  Function  Declaration 
Part/  and  Statement  Part.  All  of  the  parts  listed  may 
be  empty  except  the  last. 


EXAMPLE: 


See  individual  part  descriptions  for  specific  information 
on  each  part. 


75 


boolean  exoression 

ELEMENT: 

boolean  expression 

FORMAT: 

NOT  boolean-expression 

boolean-expression  OR    boolean-exoression 

boolean-expression  AND  boolean-expression 

{(}  exoression  re  1  a t i ona 1 -ope ra t o r  expression  {)} 

DESCRIPTION: 

Comparison  of  constant  to  constants  INTEGER  to 
INTEGER,  REAL  to  REAL,  REAL  to  INTEGER,  and  string  to 
strinq  are  allowed  in  N PS-PASCAL.  Comoarison  of 
numbers    of  aifferent   types   are   accomplished   by 

changing  the  INTEGER  number  to  REAL  prior  to 
comparison.  The  results  of  the  comoarison  are  recorded 
as  a  1  if  the  comparison  is  TRUE  and  as  a  0  i f  the 
comparison  is  FALSE. 

EXAMPLE: 


NOT  errf 1 aa 

(  X  -  3  >  0)  OR  (  errf 1 ag) 

(  Y  >  0  )  AND  (  Y  <  10) 
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case  Stat  ement 


FLEMENT: 


case  St  a t emen  t 


FORMAT : 


CASE  expression  OF  case- H st -e 1 emen t s- li st ?  END; 


DESCRIPTION: 


The  case  exoression  of  the  case  statement  is  the 
selector  for  the  case- 1 i st -e 1 emen t s- 1 i s t .  This  list 
provides  the  choices  of  statements  to  select  from.  A 
statement  whose  label  is  eaual  to  the  current  value  of 
the  selector  is  executed. 


EXAMPLE: 


CASE  i  OF 

1  :  X 

?:  X 

3:  X 

^:  X 

END 


o; 
X ; 
2x; 

limit; 
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constant  def.  part 


ELtMENT: 

costant  definition  part 

FORMAT: 

emot  y 

CONST  const  ant -def i n i t i on-1  i St ; 

DESCRIPTION: 

Constant  Definition  Part  introduces  identifiers  as 
synoniTis  for  constants.  The  constant  may  be  a  number, 
signed  or  unsianed  constant  identifier,  or  a  string. 

EXAMPLE : 

CONST  least  =  0;  most  =  50;  next  =  a; 
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conditional  statement 

ELEMENT: 

conditional  statement 

DESCRIPTION: 

Conditional  statements  for  NPS-PASCAL  fall  in  two 
categories/  the  case  statement  and  the  IF  statement, 
Languaqe  modification  to  have  NPS-PASCAL  parsable  with 
one  look  ahead  forced  a  distinction  between  two  IF 
statements.  See  balanced  statement  and  unbalanced 
statement.  The  case  statement  was  included  in  the 
simple  statements. 

I 

EXAMPLE: 

See  case  statements  balanced  statement/ 
and    unbalanced  statement. 
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compound  statement 


ELEMENT: 

coTiDOund    statement 

FORMAT: 

BEGIN  statement-list  END 

DESCRIPTION: 

Comoound  statements  specify  that  the  statements  are 
executed  in  the  same  sequence  as  they  are  written.  The 
BEGIN  and  END  reserved  words  are  the  statement 
delimiters.  A  compound  statement  can  be  used  whenever 
a  statement  is  required. 


EXAMPLE: 


BEGIN 
a 
b 
c 

END 


=  least; 
=  a  +  2 ; 

=  most 
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data  tyoe  definition 

ELEMENT : 

data  tvpe  definition 

DESCRIPTION: 

A  data  tyoe  cetermines  the  set  of  values  which 
variables  of  that  tyoe  may  assume.  It  also  associates 
an    identifier  with  the  type  Type. 

EXAMPLE: 

See  simole  tyoe*  structured  tyne/  and  pointer  type. 
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dec  1 arat  i  ons 

ELEMENT: 

dec  1  a  rat  i  ons 

DESCWIPTIGN: 

In  NPS-PASCAL  all  the  variables^  labels,  functionsr 
procedures/  constants/  and  data  types  to  be  used  in 
the  progrann  must  be  declared  at  the  beginning  of  the 
program , 

EXAMPLE: 

See  block. 
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express  1  on 


ELEMENT: 


exoress 1  on 

DESCRIPTION: 

There  are  two  types   of   expressions   in   PASCAL.   The 
boolean  expression  and  the  arithmetic  expression. 

EXAMPLE: 

See  arithmetic  expression  and  boolean  expression. 
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FOR    statennent 

ELEMENT: 

FOR  statement 

FORMAT: 

FOR  index-variable  :=  i n i t i a  1 -va 1 ue  DOWNTO  final-value 

DO  statement 
FOR  index-variable  :=  i n i t i a  1 -va 1 ue  TO  final-value 

DO  St  at ement 

DESCRIPTION: 

FOR  Statements  or  FOR  looos  are  iterative  statements 
in  PASCAL.  The  exoression  to  assign  the  initial  value 
to  the  index  variable  is  only  evaluated  once  before 
the  first  iteration  of  the  body  of  the  loop.  At  each 
iteration  the  value  of  the  index  variable  is  changed 
automatically  therefore  the  value  of  the  index 
variable  can  not  be  changed  within  the  body  of  the 
loop.  Index  variables  and  the  result  of  expressions 
giving  the  initial  value  and  final  value  must  be  of 
type  INTEGER. 

EXAMPLE  : 

FOR  i  :=  10  DOwNTO  1  DO 

totaltax  :=  salesC*  i  *)  *  taxrate; 
FOR  n  :=  (3x  ^    2)     to  (2x  +  20)  DO 

sum  :=  sum  +  n; 
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file  t  yoes 


ELEMENT: 

file  t  ypes 

FORiMA  r  ; 


TYPE  identifier  =  FILE  OF  type; 

(if  type  of  file  is  CHAR  then  file  is  textfile) 


DESCRIPTION: 


NPS-PASCAL  uses  the  word  file  to  specify  a  structure 
consisting  of  a  sequence  of  components  all  of  which 
are  of  the  same  tyoe.  Declaring  a  file  automatically 
introduces  a  buffer  variable  oointer  that  indicates 
the  component  to  read  or  aoDenn  in  the  file.  All  the 
operations  of  a  sequential  file  generation  and 
insoection  can  be  expressed  in  terms  of  four  primitive 
file  ooerators  reset*  rewrite*  get/  and  put*  with  a 
controlling  symbol  EOF, 


EXAMPLE  : 


TYPE  socsecno  =  FILE  OF  INTEGERS- 
TYPE  text  =  FILE  OF  CHAR; 
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f unc  t  i  on  call 


ELEMENT  : 

f unc  t  i  on  call 

FORMAT  : 


i  dent  i  f  i  er 
i  den  t  i  f  i  e  r 


=  function-identifier 
=  f unc t i on- i den t i f i e r 

( formal -parameter(s)  ) 


DESCRIPTION: 

Functions  may  appear  as  orimary  elements  in  arithmetic 
or  boolean  exoressions.  The  type  of  the  function  must 
be  scalar/  subrange/  or  pointer  type. 

EXAMPLE: 

Not  imolemented. 
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GOTO  statement 


ELEN'ENT: 

GOTO    statennent 

FORMAT : 

GOTO  label 

DESCRIPTION: 

GOTO  statements  serve  to  indicate  that  further 
orocessing  should  continue  at  another  part  of  the 
DPogram  text^  at  the  location  of  the  lahel.  GOTO 
statements  are  restricted  jumps  within  their  scope.  It 
is  not  possible  to  jump  into  orocedures.  Alsof  every 
label  must  be  oeclared  in  a  label  declaration  oortion 
of  the  0 rogr am , 

EXAMPLE: 

GOTO  300 
GOTO  50 
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i  d  e  n  t  i  f  i  e  r 


ELEMENT: 

i  dent  i  f  i  e  r 

FORMAT : 


letter 

letter  [{letter  or  diait  .'{letter  or  digit>> 


DESCRIPTION: 


Identifiers  serve  to  denote  constants^  types^ 
variables^  procedures/  and  functions.  They  must  begin 
with  a  letter  and  may  be  followed  by  any  combination 
of  letters  ann/or  dioits.  Identifiers  may  consist  of 
only  one  letter.  Only  the  first  eight  characters  of  an 
identifier  are  significant;  although/  the  lenghth  of 
an  identifier  may  be  up  to  32  characters.  Two  similar 
identifiers  may  be  distinguishable  if  different  in  the 
first  eight  characters. 


EXAMPLE: 


a 

sorted 
test  I 
h2owe  i  gh  t 
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IF  Stat  emen t 

ELEMENT: 

IF  Stat  emen  t 

FORMAT: 

IF  boo  1 ean-exoress i on  THEN  unbalanced-statement 
IF  boolean-expression  THEN  balanced-statement 
IF  boo  1 ean-exoress i on  THEN  balanced-statement 
ELSE  balanced-statement 

DESCRIPTION: 

IF  statements  are  statements  of  conditional  execution. 
If  the  boolean  exoression  evaluates  to  TRUE  the 
statement  following  the  reserved  word  THEN  is  executed 
and  the  ELSE  statement  is  ignored  if  aoplicable.  If 
the  boolean  expression  evaluates  to  FALSE  the  THEN 
statement  is  ignored  and  the  ELSE  statement  is 
executed  if  applicable. 


EXAMPLE: 


IF  errorflag  THEN  er rorprocedu re 
IF  (A  +  8)  <  C  THEN  C  :=  A  +  B 
ELSE  A  :=  C 
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1  nput 


ELEMENT: 


1  nou  t 


FORi^^AT: 


READ(variable-name  I  {^variable-name} ) 

READ  (  f  i  1  e-na-ne  /  variable-name  !  {  ,  va  r  i  ab  1  e-name  }  ) 

READLNC vari  abl e-1  i  st ) 

READLNCfi le-name/  variable-1 ist) 


DESCRIPT ION: 


The  READ  and  REAOLN  statements  allow  the  user  access 
to  the  input  device  to  acceot  data  for  use  in  the 
execution  of  the  NPS-PASCAL  orogram,  REAOLN  allows  to 
read  and  suosequently  s k i d  to  the  beginning  of  the 
next  line*  byoassing  any  further  oata  on  the  current 
1  i  n  e . 


EXAMPLE: 


READ(x) 
R£ADLN(x/y/z) 
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label  declaration  oart 

ELEMENT: 

label  declaration  oart 

FORMAT: 

•     LABEL    1  abe  1 -nuTiber     { »  1  abe  1 -numbe  r  >  ; 

DESCRIPTTON: 

Any  statement  in  a  NPS-PASCAL  program  may  be  marked  by 
prefixing  it  v^  i  t  n  a  numerical  label  followed  by  a 
colon.  This  allows  the  statement  to  be  referenced  by  a 
GUTQ  statement.  All  labels  must  be  defined  in  the 
label  declaration  oart  before  tneir  use,  A  label  is  an 
unsigned  integer  consistina  of  no  more  than  id    digits. 


EXAMPLE: 


LABEL  3; 

LABEL  5,15,20,35; 

LABEL  123a5b789; 
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1  abel 


ELEMENT: 

1  abel 

FORMAT: 


unsianed  integer  32  digits  or  less  in  length 


DESCRIPTION: 


See  label  declaration  part 


EXAMPLE: 


50 :  X  : 
23^568: 


=  y  f  3 
i  f  X  <  0  then  f 1 ag 


=  TRUE 
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output 


ELFMENT: 


out  out 


FORMAT : 


wRITECfi  1e-name/  variable-1  ist) 
WRITEC vari  abl e-1  i  st ) 
WRITELNCfi le-name,  variable-1 ist) 
WRITELN(vaPiable-l ist) 


DESCRIPTION 


The  WRITE  and  WRITELN  statements  allow  the  orogram 
access  to  the  output  devices.  WRITELN  terminates  the 
Current  line  of  the  output  file  after  its  parameters 
have  been  acted  upon,  wRITE  and  WRITELN  permit 
documentation  of  the  output  by  outputtinq  any 
information  between  quotations  literally. 


EXAMPLE: 


WRITEC'the  value  of  x  is'»x) 
WRITELN(  X,    sf ,     'the  average  \s*t     z) 
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program  heading 


ELEMENT: 

program  heading 

FORM-iT: 

PROGRAM  identifier  ( f i 1 e- i den t i f i e r  {, 

f  i  1 e-i  dent  i  f  i  er  > ) ; 

DESCRIPTION: 


Program  heading  gives  the  N PS-PASCAL  program  a  name 
and  lists  its  input  and  output  parameters.  The  name  is 
only  used  for  identification  ourposes  ana  is  not 
otherwise  significant  inside  the  program.  The 
parameters  indicate  the  files/devices  through  which 
the  program  communicates  with  its  environment. 


EXAMPLE 


PROGRAM  bubbl e ( i nput / output ) ; 

PROGRAM  primesCoutPut ) ; 

PROGRAM  communicate(infi 1e/Outfi I9); 
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P  roc  .  and  Func  t:  , 


ELEMENT: 
^1  Procedure  and  Function  Declaration  Part 


FORMAT : 


not  i  mo  1 emen  ted 

DESCRIPTION: 

Every  procedure  or  function  used  in  a  PASCAL-SM 
Drogram  must  be  defined  before  its  use.  Procedures  are 
Subroutines  which  are  activated  by  procedure 
statements.  Functions  are  subroutines  that  yield  a 
resultant  value/  and  therefore  can  be  used  as 
constituents  of  exoressions. 

EXAMPLE: 

See  procedure  call/  and  function  call. 
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po  i  n t  e  r  t  ype 


ELEMENT: 


pointer  t  ype 


FORMAT: 


TYPE  identifier  =  Jtype-identifier 

DESCRIPTION: 

A  pointer  type  is  a  variable  bound  to  another 
variable.  It  consists  of  an  unbounded  set  of  values 
pointing  to  its  bound  variable.  The  value  NIL  is 
always  an  element  of  a  pointer  variable  and  points  to 
no  e 1 emen  t  at  all. 

EXAMPLE: 

TYPE  link  =  5  relative 
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Procedure  call 

ELEMENT: 

Procedure  call 

FORMAT: 

CALL  orocedu re-name  {(parameter  { ^ pa ramet e r > ) } 

DESCRIPTION: 

Procedure  calls  are  the  statements  which  invoke  the 
execution  of  a  predefined  procedure.  Upon  completion 
of  the  procedure  the  execution  resumes  at  the  next 
statement  follov«ing  the  call. 


EXAMPLE: 


CALL  print  name 

CALL  largest  (number!/  number^) 
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t^ese  r  ved    words 

ELEN-'ENT: 

P?e  se  r  ved  words 

DESC^^IPTION: 

Keywords  used  in  NPS-PASCAL  are   reaserved   words   and 

are   not  allowed   to   be   used   as   identifiers.   The 

foHwing  list  are  MRS-PASCAL  reserved  woras: 


AND 

ENU 

NIL 

SEI 

ARRAY 

FILE 

NOT 

THEN 

BEGIN 

FOR 

OF 

TO 

CASE 

FUNCTION 

OR 

TYPE 

CONST 

GOTO 

PACKED 

UNTIL 

01  V 

IF 

PROCEDURE 

V  A  R 

DO 

IN 

PROGRAM 

AHILE 

DOWNTO 

LAdEL 

RECORD 

WITH 

ELSE 

MOO 

REPEAT 
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Repeat  statement 

ELEMENT: 

Repeat  s t  a t  emen t 

EXAMPLE: 

REPEAT  statement  {;statement>  UNTIL  expression 


DESCRIPTION: 


The  sequence  of  statements  is  executed  at   least 
until  the  condition  of  the  exoression  is  met. 


once 


EXAMPLE 


REPEAT  i  UNTIL  n  =  10 
REPEAT  &  initialize  arrays  R- 

A  :  =  A  +  1  ; 

B ( *  a  * )  =  0.0; 
UNTIL   A  =  10 
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Repetitive  statement 

ELEMENT: 

Reoetitive  statement 

DESCRIPTION: 

Repetitive  statements  specify  that  certain  statements 
are  to  be  executed  repeatedly.  In  some  cases  tne 
number  of  repetitions  may  be  known  before  the  first 
repetitive  execution.  In  other  cases  the  condition  to 
stop  repeating  the  execution  is  determined  after 
execution  of  a  statement. 

EXAMPLE: 

See  while  statetrentf  repeat  statement/  and 
For  Stat  emen  t . 
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RECORD    types 


ELEMENT: 

RECORD  tyoes 

FORMAT: 

TYPE  record-name  =  RECORD  field-list  END 

DESCRIPTION: 

A  record  is  a  tenplate  for  a  structure  whose  parts  may 
have  quite  distinct  characteristics.  It  consists  of  a 
fixed  number  of  comoonentSf  called  fields.  Components 
can  not  be  directly  indexed. 


EXAMPLE: 

TYPE  date 


RECORD  mo 
day 
year 
END 


(jan/apr/jul  r  oct ) i 

1..31 

INTEGER 
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rema  r k  s 


ELEMENT: 

rema  rk  s 

FORMAT : 


&  coffrnent  & 


DESCRIPTION: 


Remarks  are  usea  to  document  programs.  Any  remark 
placed  between  the  delimiters  can  be  inserted  in  a 
program  without  causinq  an  alteration  in  the  program's 
mean  i  ng . 


EXAMPLE: 


&  beginning  of  execution  phase  & 

&  this  routine  changes  integer  signs  8. 
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READ  /  REAOLN 


ELEMENT: 

READ  /  READLN  statements 

FORMAT: 

READCvari  abl  e-H  st  ) 

READ ( f i 1 e-name^  van i ab 1 e- H st ) 

READLI\l(variab]  e-1  i  st  ) 

READLNC f i 1 e-name/  va r i ab 1 e- 1 i s t ) 

DESCRIPTION: 


The  READ  and  READLN  procedures  allow  input  from 
external  Hies  or  the  default  inout  device  to  the 
program.  The  first  parameter  is  the  file  from  which  to 
access  data.  If  the  first  parameter  is  not  a  file 
identifier  then  the  default  file  is  the  default  input 
device.  Read  statements  cause  the  next  available  value 
to  be  read  from  the  file  and  assigned  to  the  variable 
whose  name  is  indicated  as  a  parameter.  When  more  than 
one  variable  value  is  read  with  the  same  statement  the 
variable  names  in  the  variable  list  are  separated  by 
commas.  See  inout. 


EXAMPLE: 


READ  (x) 
READ  (x,y,  z) 
READLN  (xC53) 
READLN  (testWx,p,r) 
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SET  types 


ELEMENT: 

SET  t  yoes 

FORMAT : 


SET  OF  base-type 


DESCRIPTION: 


SET  types  define  a  range  of  values  which  is  the  power 
set  of  its  base  type.  Base  types  must  not  be 
structured  types.  Operators  applicable  to  all  set 
t  ypes  a  re : 

f     union 

-     set  d  i  f  f erence 

*     intersection 

IN    membersh  i  p 


EXAMPLE: 


SET  OF  week 
SET  OF  fami ly 
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scalar  t  ypes 

ELEMENT: 

scalar  t  yoes 

FORMAT: 

sea  1 ar-t ype- i dent  =  (  identifier  { , i dent i f i er > ) 

DESCRIPTION: 

Scalar  type  defines  an  ordered  set  of  values  by 
enumeration  of  the  identifiers  which  denote  these 
values.  The  secuence  in  which  the  identifiers  are 
declared  is  used  in  performing  operations  on  the 
variables  assigned  this  tyoe. 


EXAMPLE: 


color 
card  = 


=  (blue/ red/ white) 
(jack/gueenrking/ace) 


105 


s  i  mp 1 e  t  ypes 

ELEMENT : 

simple  t  ypes 

FORMAT: 

sea  I  a  r-t  ype 
subranqe-t  ype 
i  dent  i  f  i  er 

DESCKIPTION: 

Simole  types  in  NPS-PASCAL  are  the  basic  elements  of 
all  type  structures.  They  consist  of  the  identifierSf 
INTEGER,  REAL,  CHAR,  and  BOOLEAN.  Scalar  defined 
tyoes  and  subranges  of  INTEGER  types,  CHAR  types,  and 
scalar  types  are  also  included  as  simple  types. 

EXAMPLE: 

See  scalar  types,  subrange  types, 
and  i  dent  i  f  i  er . 
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sub  ranqe  t  ypes 


ELEMENT: 

subrange  types 

FORMAT: 

TYPE  identifier  :  const  an t . .const  an t 

DESCRIPTION: 

Subrange  type  is  a  subrange  of  another  already  defined 
scalar  type  called  its  associate  scalar  type.  Subrange 
indicates  the  smallest  and  the  laraest  value  in  the 
subrange.   Subranges  of  REAL  are    not  allowed. 


EXAMPLE: 


VAR  small  :  1..5; 

worl<day  :  mon,.fry; 
initials  :  'a'-.^z*; 
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struct  ured  t  ypes 

ELEMENT: 

s  t  rue  t  u  red  t  ypes 

DESCRIPTION: 

Structured  types  are  composed  of  other  types.   Options 

available   to   each  structuring   method   indicate  the 

prefered    internal  data     representation.      Type 

definition   prefixed  with  the  symbol  PACKED  economizes 

storage  requirements  (Packed  option  not  implemented), 

EXAMPLE: 

See  ARRAY  type  and  RECORD  type. 
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type  BOOLEAN 

ELEMENT: 

tyoe  BOOLEAN 

DESCRIPTION: 

BOOLEAN  tyoes  assume  a  BOOLEAN  value,  one  of  the 
logical  truth  values  denoted  by  the  predefined 
identifiers  TRUE  or  FALSE.  Logical  operators  and 
relational  operators  yield  BOOLEAN  values  when  applied 
to  BOOLEAN  and  arithmetic  operands  respectively. 


EXAMPLE 


VAR  errflg  :  BOOLEAN; 

VAR  signxr  exponx  :  BOOLEAN; 
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type  CHAR 


ELEMENT: 

type  CHAR 

FORMA  r : 


TYPE  type-identifier  =  CHAR 
VAR  variable-identifier  :  CHAR 


DESCRIPTION: 


The  value  of  type  CHAR  is  an  element  of  a   finite  and 

ordered  set  of  characters.  For  NPS-PASCAL  the  CHAR  set 

is  the  ASCII  character   set.   Characters   enclosed  in 
single  quotation  marks  denote  a  constant  type. 


EXAMPLE: 


TYPE  text 
VAR  text 


=  CHAR 
CHAR 


1  10 


type    INTLGER 


ELEiMtNT: 

tvoe  INTEGER 

FORMAT: 

TYPE  type-identifier  =  INTEGER 
VAR  variable-identifier  :  INTEGER 

DESCRIPTION; 


The  type  INTEGER  is  an  eletient  of  a  defined  suDset  of 
whole  numbers.  In  N PS-PASCAL  the  range  of  integers  is 
from  -36/767  to  56/7b6.  Arithmetic  operators  with 
integer  ooeranas  yield  integer  values.  Relational 
operators  with  integer  operands  yield  BOOLEAN  values. 


EXAMPLE: 


TYPE  int  = 
VAR  a,b/C 


INTEGER 
INTEGER 
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type  REAL 


ELhMENF : 

tyoe  REAL 

FORMAT: 


TYPE  type-identifier  =  REAL 
VAR  variable-identifier  :  REAL 


DESCRIPTION: 


A  value  of  type  REAL  is  an  element  of  a  defined  subset 
of  REAL  numbers.  In  NPS-PASCAL  the  range  of  real 
numbers  is  expressed  in  BCD  formats  14  decimal  digits 
numbers^  multiplied  by  a  corresponding  power  of  ten. 
The  exponents  of  real  numbers  ranges  between  -b3  and 
bU,  Inputs  may  be  expressed  in  exoonential  form^  or 
real  format.  Decimal  period  must  be  preceded  by  at 
least  one  digit.  Arithmetic  operations  using  REAL 
number  operands  yield  REAL  value  answers.  Relational 
operators  with  real  number  operands  yield  BOOLEAN 
values. 


EXAMPLE: 


TYPE  re  =  REAL 
VAR  re.im  :  REAL 
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t  ype  de  f .  part 


ELEMENT ; 

type  definition  part 

FORMAT: 

Type  identifier  =  type  {Jidentifier  =  type> 

DESCRIPTION: 

Data  types  in  N PS-PASCAL  may  be  either  described  in 
the  variable  declaration  part  or  referenced  by  a  type 
identifier.  The  type  definition  allows  the  creation  of 
new  types.  The  definition  determines  a  set  of  values 
and  associates  an  identifier  with  the  set. 


EXAMPLE: 


TYPE  day  =  (mon , t ue ^ wed/ t hu / f r i ^ sa t / sun  )  ; 
TYPE  color  =  (red/  white/  blue); 
TYPE  arry  =  ARRAY  (*  BOOLEAN/1  ..  10  *)  OF 
INTEGER 
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unbalanced  statement 

ELEMENT: 

unbalanced  statement 

FORMAT: 

IF  expression  THEN  statement 
IF  expression  THEN  balanced-statement 
ELSE  unbalanced-statement 

DESCRIPTION: 

Unbalanced  statement  are  a  form  of  the  IF 
conditional  statement  with  an  equal  number  of  THEN  and 
ELSE  parts.  This  distiction  was  needed  to  form  a 
LALR(n  parsable  language. 

EXAMPLE: 

See  IF  statement/  and  balanced  statement. 
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variable  dec .  Daft 


ELEMENT: 

variable  declaration  oart 

FORMAT: 

VAR  identifier  { ^ i dent i f i er } :  type 

{/identifier  {^identifier}}:  type 

DESCRIPTION: 


Every  variable  occurinq  in  a  statement  must  be 
declared  in  the  variable  declaration  part  prior  to  its 
use  in  the  program.  The  variable  declaration  part 
associates  the  identifier  with  a  data  type. 


EXAMPLE: 


VAR  counter,  loop  :  INTEGER; 

errflg  :  BOOLEAN; 
VAR  pi  :  REAL; 
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APPENDIX  D  NPS-PASCAL  LANGUAGE  STKUCFUHE 

The  foHowinq  section  describes  the  NPS-PASCAL  language 
in  BNF  notation  as  mooified  to  conform  with  the  requirements 
of  reference  (10)/  Pascal  User  Manual/  and  reference  (13)/ 
User's  Guide  To  The  LALR(k)  Parser  Generator.  The 
descriotion  given  describes  the  compiler  data  structures  and 
the  code  generated.  Numbered  oroductions  without  a 
production  result  indicate  empty  productions.  Items 
enclosed  in  brackets  and  separated  by  slants  are  alternative 
semantic  actions.  This  notation  is  the  same  as  provided  by 
references  10  and  13. 


1  <program>  ::=  <program  heading>  <block>  . 

*  <program  heading>  <b1ock> 

*  ALL  ;  {  number  of  bytes  allocated  for  variables  } 

*  EN OP  ;  {  eof  indicator  } 

2  <proqram  heading>  ::=  PROGRAM  <proq  ident>  ( 

<f  i 1 e  i  dent>  )  ; 

*  <ppogram  identifier>  <file  identifier> 

3  PROGRAM  <proq  ident>  ( 

<file  ident>  /  <file  ident>  )  /* 

*  <proqram  identifier>  <file  identifiep> 

*  <f  i  1 e  i  dent  i  f  i  ep> 

a   <orog  ident>  ::=  <identifier> 
N/A 

5  <file  ident>  ;:=  <identifier> 

*  {  enter  file  identifier  } 

6  <b1ock>  ::=  <ldp>  <cdp>  <tdp>  <vdp>  <p  fdp>  <stmtp> 

*  <  label  declaration  part  > 

*  <  constant  Declaration  part  > 

*  <  type  declaration  part  > 

*  <  variable  declaration  part  > 

*  <  procedure  and  function  declaration  part  > 

*  <  program  statement  > 

7  <1 dp>  : := 

*  <  empt  y  > 
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8  LABEL  <labe1  strinq>  ; 

*  <  1 abe 1  string  > 

9  <l3bel  stpinq>  ::=  <label> 

*  <  label  >  ;  {  enter  label  } 

10  <1abelstrinq>,<label> 

*  <  label  strinq  >  <  label  >  ;'{  enter  label  > 

11  <label>  ::=  <number> 

*  <  nuTiber  >  ;  {  checl^  number  tyne  } 

12  <cdp>  :  :  = 

*  <  emp t  y  > 

13  CONST  <const  def>  ; 

*  <  constant  aefinition  > 

la  <const  def>  ::=  <ident  const  def> 

*  <  identifier  constant  definition  > 

15  <const  def>  ;  <ident  const  aef> 

*  <  constant  aefinition  > 

*  <  identifier  constant  definition  > 

16  <ident  const  def>  ::=  <ident  const>  =  <constant> 

*  <  identifier  constant  >  <  constant  > 

*  {  enter  constant  > 

17  <ident  const>  ::=  <identifier> 

*  <  identifier  >  ;  {  enter  constant  entry  > 

18  <constant>  ::=  <number> 

*  <  number  >  ;  {  assign  constant  attributes  } 

19  <sian>  <number> 

*  <  sign  >  <  number  >  ;  {  set  constant  attributes  > 

20  <constantident> 

*  <  constant  identifier  >  {  set  constant  attributes  } 

21  <siqn>  <constant  ident> 

*  <  sign  >  <  constant  identifier  > 

*  {  assign  constant  attributes  > 

22  <string> 

*  <  string  >  ;  {  assign  constant  attributes  > 

23  <constant  iaent>  ::=  <identifier> 

*  <  i  dent  i  f  i  er  > 

2a  <s  i  gn>  :  :=  ■•- 

*  {  assign  SIGNTYPE  value  > 

25 
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*  {  assign  SIGNTYPE  value  } 

2b      <tdp>  ::= 

*  <  emotv  >  ;  {  set  CASESSTMT  to    FALSE  > 

27  TYPE  <tvpe  def  st:rinq>  ; 

*  <  tyoe  aefinition  string  >  {  set  CASESSTMT  FALSE  } 

28  <tvDe  def  strinq>  ::=  <tyDe  id> 

*  <  tyoe  identifier  > 

29  <typedefstrinq>;<typeid> 

*  <  type  definition  string  >  <  type  identifier  > 

30  <type  id>  ::=  <type  ids>  =  <type> 

*  <  type  identifiers  >  <  type  > 

*  {  alter  tyoe  entry  } 

31  <type  ids>  ::=  <identifier> 

*  <  identifier  >  ;  {  enter  type  > 

32  <type>  ::=  <simple  type> 

*  <  simple  type  > 

33  <structured  type> 

*  <  structured  type  > 

34  <poi  nter  t  ype> 

*  <  po inter  type  > 

35  <sinnple  type>  ::=  <sca1ar  type> 

*  <  scalar  t  ype  > 

36  <subrange  type> 

*  <  subrange  type  > 

37  <type  ident> 

*  <  t  ype  i  dent  i  f  i  er  > 

38  <type  ident>  ::=  <identifier> 

*  <  identifier  >  ;  {  set  TYPESLOCT  > 

39  <sca1ar  type>  ::=  (  <tident  string>  ) 

*  <  type  identifier  string  > 

aO   <tident  string>  ::=  <identifier> 

*  <  i  dent  i  f  i  er  > 

*  {  enter  t  ype  > 

m  <tident  string>  r  <identifier> 

*  <  type  identifier  strina  >  <  identifier  > 

*  {  enter  t  ype  > 

42   <subranqe  type>  ::=  <constant>  ..  <constant> 

*  <  constant  >  <  constant  >  ;  {  enter  subrange  } 
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a3  <structured  tvpe>  ::=  <unpacked  structured  type> 

*  <  unoacked  structured  tyoe  > 

^^  PACKED 

<unpacked  structured  type> 

*  <  unpacked  structured  type  > 

^5  <unpacked  structured  type>  ::=  <array  type> 

*  <  sr  r^y     t  ype  > 


^6 


*  <  record  tyce  > 


<record  type'> 


a? 


*  <  set  t  ype  > 


<set  type> 


as 


*  <  file  t  ype  > 


<  f  i 1 e  t  ype> 


a9   <array  type>  ::=  ARRAY  <1p>  <index  type  strinq> 

<rp>  OF  <component  type> 

*  <  Ip  >  <  incex  type  string  >  <  rp  > 

*  <  corrponent  type  >  ;  {  enter  array  type  > 

50  <1 D>  :  :=  (* 

N/A 

51  <rp>  : : =  * ) 
N/A 

52  <index  type  string>  ::=  <index  type> 

*  <  index  type  >  ;  {  set  array  dimensions  > 

53  <index  type  string>  r 

< i  ndex  t  ype> 

*  <  index  type  string  >  <  index  type  > 

*  {  set  arra^/    dimensions  > 

5a   <index  type>  ::=  <sirnDle  type> 

*  <  s  i  mp 1 e  t  ype  > 

55  <component  type>  ::=  <type> 

*  <  type  > 

56  <record  type>  ::=  RECORD  <field  list>  END 

*  <  field  list  >  ;  {  enter  record  type  } 

57  <field  list>  ::=  <fixed  part> 

*  <  fixed  part  > 

58  <fixed  part>  ;  <variant  part> 

*  <  fixed  part  >  <  variant  part  > 

59  <var  i  an t  par t  > 

*  <  variant  part  > 
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60   <fixed  part>  ::=  <record  section> 
*  <  record  section  > 


61 


<fixed  part>  ;  <record  secfion> 
<  fixed  part  >  <  record  section  > 
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<record  section>  ::=  <field  ident  strinq> 
<  field  identifier  string  >  <  type  > 
{  enter  record  attributes  } 


<t  ype> 


63 


<  empt  y  > 


6^   <fie1d  ident  string>  ::=  <field  ident> 

*  <  field  i  den  t  i  f  i  e  r  > 

65  <field  ident  strinq>  / 

<f  i  el d  i  dent > 

*  <  field  identifier  strina  >  <  field  identifier  > 

66  <field  ident>  ::=  <identifier> 

*  <  identifier  >  ;  {  enter  record  field  } 

67  <variant  part>  ::=  CASE  <tag  field>  <type  ident>  OF 

<variant  stri  nq> 

*  <  tag  field  >  <  type  identifier  >  <  variant  string  > 

68  CASE  <type  ident>  OF 

<variant  stri  ng> 

*  <  type  identifier  >  <  variant  string  > 

69  <variant  string>  ::=  <variant> 

*  <  variant  > 

70  <variant  string>  ;  <variant> 

*  <  variant  string  >  <  variant  > 

71  <tag  field>  ::=  <field  ident>  : 

*  <  field  identifier  >  ;  {  set  TAGSFD  to  TRUE  } 

72  <variant>  ::=  <case  label  list>  :  (  <field  list>  ) 

*  <  case  label  list  >  <  field  list  > 

73 

*  <  empty  > 

7a   <case  label  list>  ::=  <case  1abel> 

*  <  case  1 abe 1  > 

75  <case  1 abe 1  1  i  st  >  i 

<case  1 abe 1 > 

*  <  case  label  list  >  <  case  label  > 


76   <case  label>  ::=  <constant> 
*  <  constant  > 
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*  [  (  set  variant  attributes  >  /  {  set  CASEsSTMT  }  ] 

77  <set  type>  ::=  SET  OF  <base  type> 

*  <  base  type  >  ;  {  enter  type  > 

78  <base  tyDe>  ::=  <simDle  type> 

*  <  s  i  mp 1 e  type  > 

79  <file  tyDe>  ::=  FILE  OF  <tyDe> 

*  <  tyoe  >  ;  {  enter  tyoe  } 

80  <pointer  type>  ::=  *  <type  ident> 

*  <  type  identifier  >  ;  {  enter  type  } 

81  <vdp>  : := 

*  <  emo t  y  > 

82  VAR  <var  declar  strinq>  ; 

*  <  variable  oeclaration  string  > 

83  <var  declar  string>  ::=  <var  declar> 
*<variableaeclaration> 

84  <var  declar  string>  t 

<var  dec  1  a  r> 

*  <  variable  declaration  string  > 

*  <  variable  aeclaration  > 


85   <var  declar>  ::=  <ident  var  string>  :  <type> 

*  <  identifier  variable  string  >  <  type  > 

*  {  set  variable  attributes  > 


86  <ident  var  string>  ::=  <identifier> 

*  <  identifier  >  ;  {  enter  variable  } 

87  <ident  var  string>  , 

< i  dent  i  f  i  er> 

*  <  identifier  variable  string  >  <  identifier  > 

*  {  enter  variable  > 

88  <p  f dp>  : : = 

*  <  empty  >  {  not  implemented  > 

89  <porf  declar> 

*  <  procedure  or  function  declaration  > 

*  {  not  implemented  } 

90  <porf  declar>  ::=  <proc  or  funct>  ; 

*  {  not  implemented  > 

91  <porf  declar>  <proc  or  funct>  ; 

*  {  not  implemented  > 

92  <proc  or  funct>  ::=  <procedure  declaration> 

*  {  not  implemented  > 
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<function  declarafion> 


*  {  not  i  fPD  1  erren  t  ed  > 


9a   <procedure  aeclaration>  ::=  <procedure  headina> 

<b 1 ock> 

*  {  not  implen^ented  > 

95   <Drocedure  headinq>  ::=  <Droc  i d>  ; 

*  {  not  1  mp  1  ernen  t  ed  } 


96 


<proc  id>  ( 

<forma1  para  sect  list>  )  ; 


*  {  not  implennented  } 


97  <proc  id>  ::=  PROCEDURE  <identifier> 

*  {  not  implemented  > 

98  <forma1  para  sect  list>  ::=  <formal  para  sect> 

*  {  not  implerrented  > 


99 


<formal  para  sect  1ist> 
;  <formal  para  sect> 


*  {  not  implemented  } 


100   <formal  para  sect>  ::=  <papa  group> 
*  {  not  implemented  > 


101 


*  {  not  implemented  ) 


102 


*  {  not  implemented  > 
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VAR  <para  group> 


FUNCTION  <para  qroup> 


PROCEDURE  <proc  ident  1ist> 


*  {  not  implemented  > 


lOa   <proc  ident  list>  ::=  <identifier> 
*  {  not  implemented  > 


105 


<proc  i  dent  1 i  s t  >  / 
<  i  dent  i  f  i  er> 


*  {  not  implemented  > 


106  <para  qroup>  ::=  <papa  ident  list>  :  <type  ident> 

*  {  not  implemented  } 

107  <papa  ident  Hst>  ::=  <identifiep> 

*  {  not  implemented  > 

108  <paraidentlist>f 

<  i  dent  i  f  i  er> 

*  {  not  implement-ed  > 

109  <function  declar>  ::=  <function  heading>  <bloclc> 
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*  {  not  imDlerrented  } 

110   <function  headina>  ::=  <funct  i  d>  :  <resLilt  type>  ; 

*  {  not  imolerrented  } 


111 


*     {    not     i  rpo  1  erren t  ed    ) 


<f unc  t  i  d>  ( 

<  f o  rma 1  oara     1  i  s  t  >  ) 

:  <resu 1 t  t  vpe>  ; 


112  <funct  id>  ::=  FUNCTION  <identifier> 

*  {  not  i mo  1 ement ed  > 

113  <result  tvDe>  ::=  <tyDe  ident> 

*  {  not  imolerrented  } 

11^  <Stmtp>  ::=  <C0'TiD0und  stmt> 

*  <  compound  statement  > 

115  <stmt>  ::=  <bal  stmt> 

*  <  balanced  statement  > 

1 16  <unbal  stmt  > 

*  <  unbalancec  statement  > 

117  <1 abel  def >  <stmt> 

*  <  label  definition  >  <  statement  > 

118  <bal  stmt>  ::=  <if  c1ause>  <true  part>  ELSE 

<bal  stmt> 

*  LBL  ;  {  If  Label  address^  > 

119  <si  mpl e  stmt> 

*  <  simple  statement  > 

120  <unbal  stmt>  ::=  <if  c1ause>  <stmt> 

*  LBL  ;  {  If  Label  addressl  > 

121  <if  c1ause>  <true  part>  ELSE 

<unbal  stmt> 

*  LBL  ;  {  If  Label  address2  > 

122  <if  clause>  ::=  <if>  <exoression>  THEN 

*  NOT  ;  BLC  ;  {  If  Label  addressl  } 

123  <i  f >  : :=  IF 

N/A 

12a  <true  part>  ::=  <bal  stmt> 

*  <  balanced  statement  > 

*  8RL  ;  {  If  Label  address2  >  ;  LBL  ; 

*  {  If  Label  addressl  > 

125  <label  def>  ::=  <label>  : 

*  <  label  >  ;  LBL  ;  {  label  address  > 
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126  <simp1e  stmt>  ::=  <ass i gnment  stmt> 

*  <  assignment  statement  > 

1^7  <procedure  stmt> 

*  <  procedure  statement  > 

12^  <repetitive  stmt> 

*  <  repetitive  statement  > 

1^^  <case  stmt> 

*  <  case  statement  > 

130  <wi  t  h  st mt  > 

*  <  with  Stat emen t  > 

1  31  <read  stmt  > 

*  <  read  statement  > 

152  <writestmt> 

*  <  write  statement  > 

133  <goto  stmt> 

*  <  aoto  statement  > 

13y  <compound  stmt> 

*  <  compound  statement  > 
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*  <  empty  statement  > 

136  <assignment  stmt>  ::=  <variab1e>  :=  <expression> 

*  <  variable  >  <  expression  >  ;  LIT  ; 

*  {  variable  address  > 

*  [  STD/STDI/STDB/  (  CNAI/STDB  )  ] 

137  <variable>  ::=  <entire  variab1e> 

*  <  entire  variable  > 

158  <variab1e>  S 

*  (  not  implemented  > 

139  <variable>  <lp>  <express  1ist>  <rp> 

*  {  not  implemented  ) 

\aO  <variab1e>  .  <fie1d  ident> 

*  {  not  implemented  } 

141  <entire  variable>  ::=  <variable  ident> 

*  <  variable  identifier  > 

ia2  <variable  iaent>  ::=  <identifier> 

*  <  identifier  >  ;  {  set  variable  location/tyoe  > 

143  <express  list>  ::=  <expression> 

*  {  not  implemented  > 


12a 


laq 


<express  list>  t     <expression> 


*  {  not  implemented  > 


laS   <expression>  ::=  <sinnple  expression> 

*  <  simple  expression  > 

146  <simp1e  expression> 

<relational  operator> 
<simple  expression> 

*  <  simple  expression  >  <  relational  operator  > 

*  <  simple  expression  >  ;  [  EQL  I /NEQ I /LEQ I /GtO I / 

*  LSSI/GRTI/  (  IN  not  implemented  )  /EQLB/NEQb/ 

*  LEQB/GEQB/LSSB/GRTB  ] 

1^7   <relational  operator>  ::=  = 

*  {  set  operator  type  } 


las 


*  {  set  operator  tyoe  > 
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*  {  set  operator  tvpe  > 


150 


*  {  set  operator  type  > 


151 


*  {  set  operator  type  } 


<  > 


<  = 


>  = 
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*  {  set  operator  type  > 


153 


{  set  operator  type  > 


IN 


15*^   <term>  ::=  <factor> 

*  <  factor  > 

155  <term>  <multiplyinq  operator>  <factor> 

*  <  term  >  <  mulitplying  operator  >  <  factor  > 

*  [  MULI/MULB/  (  CNVI  ;  CN2I  ;  DIVB  )  /DIVB 

*  DIVI/DCRI/AND  1  ;  {  MOD  not  implemented  } 

156  <multiplying  operator>  ::=  * 

*  {  set  operator  type  > 


157 


*  {  set  operator  tyoe  > 


158 


*  {  set  operator  type  > 


DIV 


159 


*  <    set  operator  type  > 


MOD 
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IbO 


AND 


*  {  set  ooerator  type  > 


161  <simole  expression>  ::=  <term> 

*  <  t  e  rm  > 

16?  <sign>  <term> 

*  <  sign  >  <  term  >  ;  [  NEGI/NEGB  ] 

163  <sinnDleexpression> 

<adc)inq  operator>  <term> 

*  <  simple  expression  >  <  adding  ooerator  >  <  term  > 

*  [  ADDI/AODB/SUBI/SUBB/BOR  ) 

16^  <addinq  ooerator>  ::=  + 

*  {  set  operator  type  } 


165 

*  {  set  operator  type  > 

166  OR 

*  {  set  operator  type  } 

167  <factor>  ::=  <variab1e> 

*  <  variabhe  >  ;  (  LDII  ;  {  interqer  value  }/ 

*  LDIB  ;  {  BCD  real  value  >/ 

*  NEGI/NEGB/LITA  ;  {  variable  address  > 

*  LOO/LODI/LODB  1 

168  <variab1e>  (  <actual  para  1ist>  ) 

*  {  not  implemented  } 

169  (  <expression>  ) 

*  <  expression  > 

170  <set> 

*  {  not  implemented  > 

171  NOT  <factor> 

*  <  factor  >  ;  NOT 

1  72  <numbe  r> 

*  <  number  > 

*  (  LDII  ;  {  integer  value  >  / 

*  LDIB  ;  {  BCD  real  value  }  J 


173 


NIL 


N/A 


17a  <st  r  i  ng> 

*  {  not  implemented  > 

175  <actual  para  list>  ::=  <actual  para> 

*  {  not  implemented  > 
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176 


*  {  not  i  nnD  1  ement  ed  } 


<ac  tual  oar  a     list>  / 
<actua1  para> 


177  <set>  ::=  <lp>  <element  Hst>  <rp> 

*  {  not  1  mo  1 emen t ed  } 

178  <element  list>  ::= 

*  <  emp  t  y  > 

179  <xe 1 ement  1  i  s t  > 

*  {  not  i  mpl  erren  t  ed  } 

180  <xe1ement  Hst>  ::=  <e1efnent> 

*  {  not  implemented  > 

181  <xelement  list>  ,     <element> 

*  {  not  i  Tip  1  enren  t  ed  > 

182  <element>  ::=  <expression> 

*  {  not  implefrented  } 

1^3  <expression>  .,  <expression> 

*  {    not     implennented    } 

18a  <goto    stfnt>    ::=    <qoto>    <label> 

*  <  goto  >  <  label  > 

*  {  I abe 1  address  } 

185  <qoto>  : :=  GOTO 

*  BRL 

186  <compound  stmt>  ::=  <begin>  <stmt  lists>  END 

*  <  begin  >  <  statement  lists  > 

187  <begin>  : :=  BEGIN 

N/A 

188  <stmt  lists>  ::=  <stmt> 

*  <  statement  > 

189  <stmtlists>;<stmt> 

*  <  statement  lists  >  <  statement  > 

190  <procedure  stmt>  ::=  <procedure  ident> 

*  {  not  implemented  } 


191 


<procedure  ident>  ( 
<ac  tual  oara  1ist>  ) 


*  {  not  implemented  > 


192  <procedure  ident>  ::=  <identif.ier> 
*  {  not  i  mpl emen t ed  } 

193  <actual  para>  ::=  <exoression> 
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*  {    not     i  mp  1  errented    } 

\9H       <rec    variable    list>     ::=    <variab1e> 

*  {    not     imDleTiented    } 


1^5 


<rec  variable  list>  , 
<vapi  abl e> 


*  {  not  i  mo  1  en-en  t  ed  > 


1^6   <read  stmt>  ::=  <read  head>  (  <io  list>  ) 

*  <  read  head  >  <  io  list  > 

197  <read  head>  ::=  READ 

*  {  set  WRITESSTMT  to  FALSE  > 

*  {  set  ALLOCATE  to  FALSE  (  don't  skio  to  new  line)  > 

198  READLN 

*  {  set  WRITESSTMT  to  FALSE  > 

*  {  set  ALLOCATE  to  TRUE  (  skip  to  new  line  )  > 

I9q   <write  stmt>  ::=  <write  head>  (  <io  list>  ) 

*  <  write  heaa  >  <  io  list  > 

*  (  i  f  ALLOCATE  then  OU^P  1 

200  <wr i  te  head> 

*  <  write  heaa  > 

*  [  i  f  ALLOCATE  then  DUMP  ] 

201  < write  head>  ::=  WRITE 

*  {  set  WRITE.ISTMT  to  TRUE  } 

*  {  set  ALLOCATE  to  FALSE  ) 

202  WRITELN 

*  {  set  WRITEJSTMT  to  TRUE  } 

*  {  set  ALLOCATE  to  TRUE  } 

203  <io  list>  ::=  <file  ident>  *  f     <\jar    list> 

*  {  not  implerrented  > 

20a  <\/ar    1  i  st  > 

*  <  variable  list  > 

205  <\/ar    1ist>  ::=  <variable> 

*  <  variable  >  ;  [  WRV I /WRVB/RDV I /RDVB 

*  (  STDI/STDB  -  read  statements  only  )  1 
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207 


<s t  r  i  nq> 

<  string  >  ;  WRVS  ;  {  string  } 
{  write  statement  only  > 

<\/ar    list>  f  <variable> 

<  variable  list  >  <  variable  > 

[  WRVI/WRVB/RDVI/RDVB  (  STDI/STDB  - 
read  statement  only  )  1 


128 


2U8  <varlist>»<strinq> 

*  <  variable  list  >  <  string  > 

*  '.nRVS  ;  {  string  }  (  write  statement  only  ) 

209  <case  stmt>  ::=  <case  express> 

<case  list  eleT^t  1ist>  END 

*  {noti'T'olerrenterj} 

210  <case  express>  ::=  CASE  <exDression>  OF 

*  {  not  implerrenteci  > 

211  <case  list  elemt  list>  ::=  <case  list  elemt> 

*  {  not  imolemented  } 


212 


<case  list  e 1 emt  1  i  st  > 
<case  list  elemt> 


*  {  not  i  mp  1  ennen t ed  > 


213   <case  list  elemt>  t:= 

*  <  empty  > 

2ia  <case  label  list>  :  <stmt> 

*  {  not  implerrented  } 

215  <repetitive  stmt>  ::=  <while  stmt> 

*  <  while  statement  > 

216  <reDeatstmt> 

*  <  repeat  statement  > 

217  <foPStmt> 

*  <  for  st  at ement  > 

218  <with  stmt>  ::=  <with>  <rec  variable  list>  <do> 

<bal  stmt> 

*  {  not  implemented  } 

219  <wi  th>  : :=  aITH 

*  {  not  implemented  } 

220  <do>  : :=  DO 

*  {  not  implemented  } 

221  <while  stmt>  ::=  <while>  <exppession>  <do> 

<bal  stmt> 

*  {  not  implemented  } 

222  <whi le>  : :=  WHILE 

*  {  not  implemented  > 

223  <for  stmt>  ::=  <for>  <control  variable>  := 

<for  list>  <do>  <ba1  stmt> 

*  {  not  implemented  > 

22a   <f or>  : :=  FOR 
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*  {  not  i  mo  1  errent  ed  > 

?^5   <for  list:>  ::=  <initial  list>  <to>  <final  value> 

*  {  not  i  rrp  1  errent  ed  > 

?2b  <initial  va 1 ue><downt o>  <final  va1ue> 

*  {  not  i mo  1 eTen r ed  > 

227  <control  variable>  ::=  <identifier> 

*  {  not  i  mo  1  errent  ed  > 

228  <initial  value>  ::=  <expression> 

*  {  not  i  rpD  1  errent  ed  > 

229  <final  value>  ::=  <expression> 

*  {  not  i  mo  1  err  en  t  ed  > 

25  0       <reDeat     strr>t>     ::=    <reDeat>    <stmt     Hsts>    <unti1> 

<expressi  on> 

*  <  repeat  >  <  statement  lists  >  <  until  > 

*  <  expression  >  ;  NOT  ;  BLC  ;  <  set  REPEATJLBL  } 

231   <repeat>  ::=  REPEAT 

*  L6L  ;  {  REPEATSLBL  > 

21>2       <unt  i  1  >  :  :=  UNTIL 

N/A 

233   <to>  ::=  TO 

*  {  not  i  rpp  1  emen  t  ed  > 

23a   <downto>  ::=  DOWNTO 

*  {  not  implemented  > 
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NPG- PASCAL  PROGRAM  LISTINGS 


*180h:  /*load    point    for    compiler*/ 

/***  system         literals  **» 


dec lare 

lit      literally  ' 

' literally' , 

cr 

lit 

'13', 

If 

lit 

'©ah'  , 

del 

lit 

' dec lare ' , 

pos 

lit 

'0'. 

neg 

lit 

•  1'  , 

tab 

lit 

•09h' , 

proc 

lit 

'procedure '  , 

bdos 

lit 

•5h',         /*< 

boo  t 

lit 

'0' ,                      /« 

true 

lit 

'  1'  , 

addr 

lit 

' address  '  , 

minusx 

lit 

'2dh'  , 

rf  ile 

lit 

'20', 

false 

lit 

'0'  , 

maKint 

lit 

'32767' , 

beds  ize 

lit 

'8', 

ands  ign 

lit 

'26h'  , 

f ileeof 

lit 

'  1'  , 

eo  letiar 

lit 

'Odh' , 

maxGnes  t 

lit 

'3'  , 

forever 

lit 

' whi le  true' , 

e  o  mme  n  t 

lit 

'0', 

vares  ize 

lit 

' 100' , 

hashmask 

lit 

' 127' , 

f ormmask 

lit 

'7'  , 

typeSentry 

lit 

'2', 

varOentry 

lit 

'3'  , 

typeSdc le 

lit 

'7', 

type mask 

lit 

'00111000b' , 

contehar 

lit 

'5ch' , 

codes  ize 

addr 

,        /«  used 

idents  ize 

lit 

'32'  , 

eof f i  1  ler 

lit 

'  lah'  , 

s  ta  tes  ize 

lit 

'address ' , 

indexs  ize 

lit 

'  address '  , 

ps  tacks  ize 

lit 

'48',          /* 

f irstGt  ime 

byte 

initial  (true) 

ident  if  ier 

lit 

'62'  , 

intrecs  ize 

lit 

' 128' , 

f i leCentry 

lit 

'6'  , 

lablSentry 

lit 

'0'  , 

consGentry 

lit 

'1'. 

maxoncount 

lit 

'25', 

conbuf f s  ize 

lit 

'82'  , 

s  tr  ingde 1 im 

lit 

'27h' , 

hashtbls  ize 

lit 

' 128' , 

quest  ionmark 

lit 

'3fh' , 

maxOnumOarrySd  imen 

lit  '5'  , 

arrySnes  t 

lit 

'4'  , 

consGstrStype 

lit 

•3', 

cons  GnumS  t  ype 

lit 

'0', 

consSidentGtype  li 

t  '  1'  , 

consGs identStype  1 

it  '2' , 

sourcerecs  ize 

lit 

' 128' ; 

/Gentry   point    to    disk   op.    sys*/ 
exit     to    return    to    op.     sys.     * 


to    count    size    of    code    area    */ 


stack   size    for    parser    */ 


/*    number    types    */ 
del  ordStypc  lit 
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charGtype 
iategerC type 
rea 10 type 
uns  ignOexpoa 
s  ignedGespoa 
c  o  mp  1  e  sO  t  ype 
s  tr  ingCtype 
boo  ieazi'J  type 
s  igntype 
cons  tGtype 

dc  1      mairrno 
max  ino 
maspno 
mass no 
s  tar  ts 
prodno 
eo  f  c 
nuiaberc 
s  tr  ingc 
ternino 

dc 1      sb  loc 
form 
expon 
ve  c  p  t  r 
1  ineno 
typonuni 
r f cbaddr 
cons  tSp tr 
s  tar  tbdos 
lal>  Icouut 
mazz 

err or count 
typeOaddr 
typeO loc  t 
varCp  tr 
varO type ( 10) 
varOs  i^n(  10) 
espG type (11) 


lit 

lit 

lit 

lit 

lit 

lit 

lit 

lit 

byte 

byte 

lit 
lit 
lit 
lit 
lit 
lit 
lit 
lit 
lit 
lit 


•2' 

'  1' 
'2' 
'3' 

•4' 
•4' 

'4' 
'5' 


/^    type  of  constant  */ 


•  192' 
'251' 
'276' 
'510' 
'  1'  , 

•  234 ' 
•25'  , 
'58'  . 
'59'  , 
'62'  ; 


addr 

byte  , 

byte  , 

byte  , 

addr , 

byte  , 

addr 

byte  , 

addr 

addr 

based 

addr 

addr  , 

addr , 
byte  , 
byte  , 
byte  , 
byte,  /^' 


init  iaKSOh) 


mn-A   read  count  */ 

majr  look  count  */ 

max  push  count  */ 

mas  state  count  */ 

start  state  */ 

number  of  productions  */ 

eof  */ 

number  ^S/ 

string  */ 

terminal  count  */ 


initial    ( 5ch) , 

initial(6h),    />r;addr    of 
initial(O),       y^-    number 
startbdos    addr, 
init  ial    (0)  , 


ptr    to    top    of    bdos*/ 
of     labels    used    */ 


expGtype3addr(  1 1)    addr,    /« 


espGptr  byte     initial    (0), 

opOtype(lO)       byte, 

opCptr  byte     initial    (0), 

caseGstmt  byte     initial    (false), 

writeGstmt  byte     initial    (false), 

repea tGlb  1(  10)     addr, 

repeatOptr  byte    initial    (0), 

allocate  byte,    /*    true    or    false 

a  1 IcGbas icG type    byte, 

arryGqty( maxOnumOarryCd imen)    addr, 

varGbaseC 10)       addr, 

varObase  1(  10)     addr, 

byte  , 

addr , 

byte  , 

addr  initial    (0)  , 

byte  , 

adlr, 

byte  , 

addr , 

byte  , 


type    of    expression    'i^/ 

addr    of    scalar    parent     type    '-■'/ 


/if. 
/% 


in 

in 


case  s  tmt  */ 
wr  i  te  s  tmt  */ 


%/ 


typeO  inds 

allcGqty 

typef orm 

a  1  locGaddr 

typeGordOnum 

parentGtype 

cons  tGindx 

lookupGaddr 

cons  t3vec(  4) 

cons tGva lue(  162)    byte, 

cons  tGpnGliash(  4)     byte, 

constGpnGptr  byte, 

cons tGpnGs ize( 4)     byte, 

integerGdiff  addr, 

subrGval(2)  addr, 

subrGtype(2)  byte, 

subrCptr  byte, 

subrGtypeGaddr         addr, 

subrOform  byte. 
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subrOpnCs Iga  byte, 
arryObase  addr, 
arryCptr  byte, 

arryOd  iniQptr  byte, 
ptrptr  byte, 

ii'-^Ptr  byte  initial  (255), 

ifClbKl)        addr,  /«  if  statement  stack  */ 

tagSf d( maxOnes t )  byte, 
varOcasOtp( maxOnes t )  addr, 
varOcasSva 1( maxOnes t)  addr, 
recOvarGtyp( maxGnes t )  byte, 
recJnst      byte   initial  (255), 
recordOptr       byte, 
recCaddr(6)      addr, 
rec3parCadr( maxOnes t )  addr, 
var iantCpar t( maxOnes t)     byte, 
fxdGofs tGbse(maxOnest)  addr, 
varGofs tGbse( raaxOnes t)  addr, 
curOo f 3  I ( maxGnes t )       addr, 
nuniOarr^rOd  i!nen(  luaxGnumGarryGd  imen)  byte  , 
arryOd  i!i:en(  25)  addr, 
aryOdniGadrSptr  byte, 
cons tGnuaGtype ( 4)  byte, 
bcdnum( beds ize)  byte, 

rfcb  based     rfcbaddr  (33)  byte, 

no  look         byte , 

lineptr        byte      initial  (0), 
buffptr        byte      initial  (255), 

wfcb(33)       byte      initial  (0,'  ' , ' pin' , 0, 0, 0, 0) , 

sourceptr      byte      initial  ( sourcerecs ize) , 
nointfile      byte      initial  (false), 

sourcebuff     baaed     sbloc    ( sourcerecs ize )   byte, 
production     byte, 
prvGsb tb ISentry  addr, 

cursourcerecs ize  byte   initial  ( sourcerecs ize) , 
1 inebuf f ( conbuf fs ize)   byte, 
diskoutbuf f ( intrecs ize)   byte; 

del      ini tGsymbGlbl  da ta( 0, 0, 0 , 0 , 42h, 7, ' i ' , ' n' , ' t ' , ' e ' , ' g' , ' e ' , 

'r'  ,0,O,O,O,4ah,4,  'r'.'e'.'a^'l'  ,  0  ,  0  ,  0,  0  ,  52h,  4 ,  '  c  '  .  '  li'  ,  '  a  '  , 
'r' ,0,0,0,0,5ah,7, •b'.'o','o','l','e','a','n',0,0,O,0,0efa. 
5,'i','n','p','u','t',0,O,0,0,leh.5,'o','u','t','p','u','t', 
0,0,0,0,O9h,4. 't','r','u','e' , 0, 0, 0, 0 , 0, 0, 0, 0, 09h, 5 , ' f ' , 'a' , 
' 1' , 's' . 'e' ,0,0, 1,0) ; 

/  *!*  *i*  Jf*  •?•  5|C  IfC  5s  3fC  *j»  is  5f* 'K 'N  *^  •K  •i^  51* '^ 

/«««  scanner      global      variables  *** 

del  token  byte,  /«    type    of    token    Just    scanned    * 

hashcode  byte,  /=>'    has    value    of    current    token    ^ 

nextchar  byte,  /^-current    character    fm   getchar>iJ 

cont  byte,  /*indx    full    accuni.    still    more    * 

accuin(  identsize)       byte;  /*    holds    current    token    */ 

/  )js  5JC  y  5jC  5|^  ffi  "ifi  <C  3fC  ^  5jt  5rC  JfC  tH  5t*  3j*  ^  ^fC  5K  ^l^  'T^  ^K  51^  'T*  ^  'f^  'o  "t*  *f>  ^  '**  *l>  'T*  '(^  'T*  'o  'T*  '<*  'i^  *>*  *«*  'S  'T^  'K  *(*  *tS  ^t*  *tS  ^*^*tS  'T^  'K  *!»  "f*  ^  ?K  'J^  'i*  ^  'S  'r*  'I*  *!»  •T*  'jy  'K  •1>  '?»  »1* 

/**«  symbol    table    global    variables  *** 

del  base  addr,  /*base    of    current    entry  */ 

hashtab le(hashtb Is ize)    addr, 

sbtbltop  addr,  /^current    top    of    table    (sym)       */ 

sbtbl  addr, 

ptr    based  base    byte,  /*    1st    byte    of    entry  */ 

aptraddr  addr,  /*    utility   variable    to    access     table       */ 

addrptr    based    aptraddr    addr, 
byteptr    based    aptraddr    byte. 
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prinlname 
symhash 


addr, 
byte  ; 


/*    set    prior    to     lookup    or    enter 


*/ 


dec  lare 
.62, 
.58, 
.32, 
.38, 
.30, 
,3.  1 
,S,3 
.  11, 
,  14, 


read  1 
62,62 
59,62 
58,59 
39 ,  42 
62,20 
3,  14, 
,8,28 
13.  11 
21,23 


da 
,62 
,3, 

,62 
,44 
.29 
11. 
.8, 
,  13 
,4, 


ta( 0.56. 25, 12, 14,62,62,34,60.61,62,59,62,62, 11,8,8,8  13 
,62,59,62,59,62,14,3,4,9,58,59.62,3,4,5,9,33.37,43,51,5 
4,9,53,59,62,3,16.31,32,58,59,62,22,62,62,62.3,4  9  16  3 
,22,62. 16.62,58,33,37,43.53,35,62,62,62,62,62,20.29  35 
.48,49,52,54,57,62,22,41,62,45,34,60,61,58,62,6, 10,26,2 
,35,38,39,42,44,48,49,52,54,57,58,62,1,13,44,7,7  3  8  15 
1,5,  16,  18, 1,3,5,  16,8,3,36,36,22,40,  19,7, 15,28,7,7, 1 17 
47,22,22,3,11. 17, 13, 14, 8,8, 17,8, 11, 24,50,8, 3,7, 11.11 !8' 
, 11, 13. 11.3.46,8,7. 11.7. 11, 18, 11, 13, 11, 17, 11, 19,2,4,9, 1 
9,23,8, 11, 13,8,28,7,8,7,8,0,0,0,0,0) ; 


declare  lookl  da ta( 0 , 12 , 14 , 0, 35 , 62, 0, 62, 0, 62, 0, 62, 0, 35 , 62 , 0, 8, 28, 47  0  8 
,28,0,7,8,28.0. 14, 0,8, 20, 0,7, 3, 28, 0,7, 3, 28, 0,8, 23, 36, 47, 0,36, 0.35! 6 
,0,15,0,1,5,16,18,0,13,0,6,0,0.0.0.17.0.41.0.45.0.34.0.44.0  6  10  26 
,27,30,0,6, 10,26,27,30,0,6,  10,26,27,30,0,8,28,0,8,47,0,36,0,  11  o' 11 
,0,  1.3,5,  16,0,  11,  19,0,7,  11,0,  11,  19,0,7,  11,  0,8,  28, 36,  47,  0.36,  0,3,-^3 
, 47, 0, 15, 0, 8, 0, 3, 0. 44, 0,8, 23, 0,11, 0,0, 0,8, 0,11. 0.3.0. 46, 0, 46, 0, 46, 0 
,2,4,9, 12, 14,21,23,0,4,9,23,0) ; 


declare  applyl  da ta( 0 , 0, 0, 0, 5 , 30, 0 , 179 , 182, 0, 
,27,28,37,52,54,60,62, 158,0,98,0,27,23,35 
, 6 1 , 62 , S7 , 1 58 , 0 , 0 , 0 , 22 , 0 , 0 , 45 , 47 , 59 , 6 1 , 0 , 
,  132,0,0,0,0,0,76,0.0,73, 121, 122,  123,  124, 
, 0 , 0 , 1 4 , 0 . 0 , 24 , 0 , 0 , 3 , 33 , 67 , 0 , 24 , 0 , 62 , 0 . 0 , 
,0,0, 23, 0,0, 0,0, 155, 0.0. 0.0, 8,0, 26. 0,0, 66 
, 128, 130,0,69,70,83.84,85, 123, 129,0,69,0, 
,0,0. 10, 11,25,36,41,43,49,69,70,83,84,85, 
, 0 , 0 , 9 , 39 , 40 , 55 , 56 , 57 , 68, 85 , 83, 89 , 9 1 , 108, 
,0,0,63,  190,0,  13,0,0,0,0,39,0,0,0, 107,0,0 
, 11,0,43,0,0,0,0,27,0,0,0,0, 116, 137,0,0,0 
)  ; 


0.0,29,75,97,0,0,0,21,0,0 
, 37 , 45 , 47 , 52 , 53 , 54 , 58 , 59 , 6 
35.58.87.0, 15,46,48,50,67 
125, 126,0, 152, 159,0,0,35,0 
28,0,27, 153,0,37,0,0,0,0.0 
, 80 . 0 , 0 , 0 , 0 , 0 . 50 , 0 , 0 . 25 . 49 
70,83,84,85, 129,0,0, 129,0, 
103,  104, 111.  128.  129. 130,0. 
109,  110,0,0.99. 168.0.0, 188 
,111, 0,0,0, 42, 0,0, 0,0, 0,0 
,0,0, 0,0,0, 110, 0,0, 0,0, 0,0 


del 


del 


del 


read2(236 

,278,279,372 
,294,293,299 
,298,209,9,3 
,63,448.450. 
.380.399,500 
.65.79,31,29 
,498,477.474 
.414.326,56, 
, 17,30, 13, 16 
,327,234,29, 
,75, 196,467, 
, 442 , 440 , 44 1 


)  addr  initial 

(0,78,277,424,425 
,50,363,317,342.384 
,6,300. 15,301.64.71 
26 . 449 , 63 , 443 , 450 , 4 
418,59,307,326,293, 
,68,461,473,495,463 
5 , 299 , 432 , 433 , 436 , 4 
,507,478,287.210.2, 
3, 13,414,326,  195,  10 
, 193.5, 199,462, 199. 
509,510,366,367,315 
42,444.42,57,31,45, 
,442, 197,33,47,200, 


,281,316,66,80,32,383,482,212,314,43 
.381,484,413,432,418,426, 194,300,301 
, 73 , 76 , 208 , 294 , 293, 209 , 6 , 300 , 30 1 , 294 
13 , 53 , 362 , 383 ,211,9, 300 , 30 1 , 326 , 449 
2S7 , 64 , 7 1 , 73 , 203 , 67 , 342 . 280 . 388 . 373 
. 493 , 477 , 474 , 507 , 478 , 2 1 0 , 6 1 , 72 , 503 , 7 
34 , 435 , 4 13, 399 , 500 , 68 , 46 1 , 473 , 495 , 46 
40 1 , 463 , 472 , 475 , 7 , 37 1 , 34 , 3 , 46 , 53 , 4 1 . 
, 206 , 207 , 486 , 398 , 496 , 445 , 55 , 332 , 348 
508, 204 , 205 , 1 1 , 40 , 327 . 347 , 52 , 386 , 337 
, 32 , 39 , 20 1 , 37 , 203 , 37 , 5 1 , 34 , 48 , 38 , 1 2 
35 , 327 , 36 , 496 , 193 , 440 , 44 1 . 202 , 423 , 42 
485, 19,26,20,26,0,0,0,0,0) ; 


looli2(  171)    addr     initial 

(0,4,4,427. 14, 14,252,21,289,22,303, 
, 254 , 254 , 254 , 25 , 255 , 255 , 27 , 256 , 256 , 256 , 23, 44, 428, 
, 258 , 60 , 259 . 259 , 259 , 62 , 260 , 260 , 260 , 260 . 69 , 26 1 . 70 . 
,413,413,418,413,468,342,314,231,418,83,84,85,263 
,95,266,267,96, 100, 100, 100, 100, 100,437, 101, 101, 10 
, 102, 102, 102, 102,439,268,268, 104,269,269, 111,400, 
, 122, 122, 122, 122,443,470,470, 123,431,481, 124,471, 
,270,270,270,270,  123,271,  129,272,272,272,  130,  139, 
,365, 155,273,273, 153, 165.455, 166,344, 167,343, 172, 
, 179,275, 182,276, 184, 184, 184, 184, 184, 184, 184,421, 


23,358,24.24.253 
257.257,49,258,253 
77,77,262,299.314 
,83,92,264,94,265 
1.  101, 101,438,  102 
391  ,  1  19.480, 120,47 
471, 125,483,433, 12 
458, 145,333, 151,47 
379,  173.466,  174,27 
185, 185, 185,422) ; 


apply2(273)  addr  initial 

(0,0,247, 146, 142, 143, 144,385,370, 105,218, 160,286,285 
,460, 106,217. 127.291,290, 154,352,352,352,292,318,352.352.352. 115.29 
.296.93,98,98,98,93,93,93,98,98,93,93,93,93,98,98,98,99,219, 17  5,305 
,304, 1 18,361 ,338,355,331,306,330,354,330,303,356,339,382,389,  149,  15 
,313,31 1 , 164,312,309,320,319,321 ,87,89,89,89,89,89,89,216,415,453,9 
, 181,329,328,325,322, 141, 140,233,337,336, 187,416,341, 153,340,334,33 
,244,243,  132,346,345,  169, 169, 170,351,350,323,353,324,310,220. 186.36 
,359, 180, 107,240, 163, 162,368,249, 114, 192, 191,375,374,245,377,378,37 
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del 


,  171,369,243, 

.220,403.391, 
,231,231, 121, 
,  121,229,410, 
, i37,505,4o9, 
, 159,242,457, 
, 131,403,239, 
,213,49 i ,  1G9, 

indeaiKSll 


,  13,?o,T 
,S4,S6,2 
,60,61,6: 
,64,47,6 
,  116,  130 
, 142, 146 
,  157,  15S 
, 105. 173 
,  197,  193 
,225,53, 
,59,61,6: 
, 115,  113 
, 157,  159 
,357,364 
, 12,  16,  1 
,54,54,5 
,91,92,9 
, 110,  113 
, 126, 126 
, 148, 141 
, 171, 171 
, 194,  194 
,214,215 
,223,224 
,239,239 
,250.230 
, 265 . 256 


^.61, 

5,35, 

:,63, 

i,64, 

131, 

142, 

159, 

179, 

199, 

i27  '^ 

>,63, 

121, 

167, 

411, 

.,  17, 

»,59, 

S,93, 

1 15 , 

123, 

141, 

171, 

195, 

215, 

224, 

240, 

251, 

268, 


1 17 . 157 . 156 . 252 . 465 . 490 . 396 . 393 . 464 . 394 . 394 . 494 . 497 . 49 
397,302,235,235,235,235,205,234,86, 134, 133,226,395,402 
232,233,231, 121 ,  121 , 121 , 121 ,  121 ,  121 , 230 ,  121 ,  121 ,  121 ,  12 

417. 152. 133.237.420.459.412.504. 135. 136.237.419.505.50 
133,222,223,221, 190,251,250, 168,447,431,430, 177, 176,44 
456,409,97,390,410,224, 148, 147,403,246,452,451, 183,407 
113, 112,223,227,405,241, 139,488,487,404,406, 103,215,21 
493,93, iio, 173, 161,502,501.492,225, 108,91, 110) ; 

)  addr  initial 

(0, 1,2,21,3,5,6,7,7,64, 11, 11,64,64,82, 13, 14, 15, 16, 17 
82, 115, 7, 00, 30, 77, 5, 19,20,21,22,47, 115,30,23,64,64,24 
13,35, 13, 116, 13,29,30,35,30,64,64,64,47,35,30,35,30,53 
64 , as , 83 , 73 , 74 , 75 , 76 , 77 , 78 , 32 , 84 , 85 , 62 , 86 , 87 , 88, 88 , 88 
101,64, 102, 103, 104, 105, 106.77, 108,53, 110, 110, 110, 115 
132,64,64,64, 116, 133, 134, 135, 137, 156, 138, 140, 141, 141 
142, 142, 142, 150, 116,88, 116, 151, 13,  152,  153,  154,  155,  156 
160,  161, 163, 164,  165, 166, 167,  169, 171, 172,  173,  174, 176,  17 
30,  130, 131,  180,  135, 136, 137, 139, 190, 190,53, 191,  193,  195 
200.201,203,205, 199,206,203, 199,210,212,219,222,223.64 
29, 1,4,7,9, 11, 13, 16,20,23,27,29,32,36,40,45,47,50,52.5 
64,66,63,70,72,74,30,86,92,95,98, 100, 102, 104,  109,  112 
125. 123. 132. 134. 136.  133. 140.  143. 145 . 147. 149 .  15  1 .  153.  15 
339 , 339 ,411, 439 , 349 ,411, 349 , 349 ,411,411, 339 , 454 , 302 , 28 
411,411,411,411,469,233,203,283, 1,2,2,3,4,7, 10, 10,  11,1 
17 , 13 , 20 , 2 1 , 2 1 , 2 1 , 2 1 , 2 1 , 30 , 32 , 32 , 49 , 49 , 50 , 50 , 5 1 , 53 , 54 
59 , 63 , 70 , 7 1 , 7 1 , 72 , 73 , 73 , 74 , 74 , 74 , 74 , 76 , 77 , 85 , 88 , 88 , 89 
93,95,95,96,96,98,98,99, 103, 103, 105 , 105 , 107, 108, 108, 1 1 
116, 117, 113, 119, 119, 120, 120,  121, 123, 123,  124,  124,  125,  12 
129,  129, 130, 131, 131, 133, 133,  133, 133,  135,  135,  136,  139, 13 
142, 143,  145, 146,  146, 146, 151, 151,  159,  159,  161,  167,  168,  17 
171, 171,  171, 171, 171,  171,  171,  172,  170, 173, 173,  173,  192,  19 
195,210,210,210,210.210,210,210,211,211,214,214,214,21 
215,217,217,217,218,218,218,218,218,218,218,218,221,22 
225 , 225 , 226 , 226 , 228 , 229 , 230 , 232 , 233 , 233 , 235 , 235 , 236 , 23 
24 1 ,  24 1 ,  242 ,  242 ,  243 ,  243 ,  244 ,  244 ,  246  ,  246  ,  246  ,  246 ,  248 ,  24 
25 1 , 250 , 253 , 250 , 254 , 255 , 256 , 259 , 260 , 26 1 , 262 , 263 , 263 , 26 
269,270,271,272); 


declare  i2idez2  da  ta(  0  ,  1  ,  1  .  1 ,  2,  1  ,  1  ,  4  ,  4  ,  9 

.,5, 5,  1,1,  1,1,  1,1, 6,  1,5,  1,9, 9. 2, 9, 

,6,  12,5, 12,5,7,  1,  1,  1, 1,9, 13,  13,  1,  1, 

,9, 9,  1,9,  1,1,  1,1, 2,  1,2, 7, 5, 5, 5,1,  14 

,4,4,3,3,3,3,  1, 14,  13,  14,  1,  1,  1,  1,  1,  1 

1,1, 2,  1,1, 5,  1,2, 2,  1,1, 2, 1,1, 1,7, 2, 

,2,9,2,7,2,2,3,3,2,2,2,3,4,3,4,2,3, 

6,6,6,3,3,2,2,2,5,3,3,3,3,5,2,4,2. 

25 , 27 , 23 , 49 , 60 , 62 , 69 , 70 , 77 , 38, 92 , 9 

174, 179, 182,3,5,7,0,0,5,0,2,0,2,0, 

,2,2,0,0,0,0,0,0,0,0,2,0,2,2,0,1,0, 

,0,0, 2, 0,4, 3, 0,2,  1,4, 0,0, 2, 0,2, 0,2, 

1,0, 2, 0,1,  1.1, 0,2, 2, 0,2,  1,3, 6, 1,0, 

,0,0,0,0,0,2,0,1,3,2,0,0,0,2,0,2,0, 

,0,0,0,3,2,0,1,0,0,0,0,2,2,0,0,0,2, 

,3,0,0,0,3,0,0,0,2,2,2,2,0,2,0,2,0, 

,0,0); 


2  2 

2T1T 
1,1, 
,  1,  1 
.1,  1 
2,2, 
4,4, 
2,2, 
4,95 
0,2, 
0,0, 
1,0, 
0.0, 
1,1, 
0,2, 
0,0. 


,9,2,  1, 
12,  1,  12,  1 
1.4,2,  1,  1 
. 1,9,9,9, 
,1,1,1,2, 
1,1,1.1,2 
5,2,3,2,5 
2,3,2,2,2 
,96, 104,  1 
0,2,2,0,0 
0,5,0,0,0 
2,0,2,2,0 
0,  1,3,0,  1 
1,0,0,0,0 
1,0,2,0,0 
3,0,0,3,0 


1.1,1, 
,14, 1, 
,1,1,1 
14,  1,  1 
1,  1,  1, 
,2,  1,  1 
,2,2,  1 
,2,2,2 
11, 128 
,1.0,1 
,2,0,0 
,2,0,0 
,3,2,0 
.2,0,0 
,2,0,3 
,5,0,2 


1,1,1 
1,5,1 
,  13,  1 
,2,  1, 
1.2,2 
,2,2, 
.1,1, 
2,  2 

!  129! 
.0,0, 
,2,0, 
,  1.2, 
,0. 1, 
.0.0. 
.0.0, 
.2,0, 


.1,1 
2,5, 

3,  13 
1,2, 
,1.1 
1,2, 
2,2, 
8,4, 
130, 
0,0, 
2,0, 
0,0, 
0.0, 
0,0. 
0,2, 
0,0, 


.2,  1 

9,9, 

.9,6 

1,  1, 

,  1,2 

7,3, 

2,2. 

14,2 

153 

0.2, 

0.2, 

1,1, 

0,0, 

1,2, 

3,0, 

3,0, 


/*:;{*  global         procedures  *** 


monl :    proc( f , a)  ; 

del  f    byte, 

a    addr; 

go    to    bdos ; 
e  nd    mo  n  1  ; 


mon2:    proc    (f,a)    byte; 
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del  f    byte,    a    addr; 

g^o    to    bdos ; 
e  nd    mo  n2  ; 


mon3 : proc ; 

go  to    boo  t ; 
e  nd    mo  n3  ; 


/«used    to    return    to    the    system* 


move:  proc  (a,b,l); 

del      (a,b)  addr, 
(s  based  a,  d  based  b,l)  byte; 
do  while  (1:=1  -  1)  <>  255; 
d  =  s; 

b=b    +     1; 
a=a    +1; 
end  ; 
end    move  ; 


/Amoves    fm  a    to    b    for    1    bytes    * 
/-    1    <    255    bytes    «/ 


fill!    proc    (a, char, n); 


del    a    addr  ,  (  cliar  ,  n,  des  t    based    a)    byte; 
do    while    (n    :=    u   -1)    <>    255; 

des  t    =    char ; 

a    =    a    +    1; 
end  ; 
end    fill; 


/*    move    char    to    a    n    times    #/ 


read:    proc; 

del     toggle(3)     byte; 

toggle    =     1; 

call    monlC 10, . toggle)  ; 
end    read; 


printchar:    proc(char); 

dc  1  char    byte  ; 

call    mo  n  1(2,  char); 
end    printchar; 


print :  proc( a) ; 

dc 1      a  addr; 

call  monl(9,a); 
end  print; 


diskerr'  proc; 

do  ; 

ca 1 1    pr int( . ' de 
5  goto    boot; 

end ; 
end    diskerr; 


); 


se tupOintSf  i le :proc  ; 

if  nointfile  then   /«  only  make  file  if  this  toggle  off  */ 

re  turn; 
call  move(  .  rfeb  ,  .  wf  cb  ,  9)  ; 

wfcb(32)  =  0; 
call  monl( 19 , . wf cb) ; 
if  mon2(22, . wfeb)  =  255  then 
ca 11  d  iskerr ; 
end  se tupGintOf i le; 

wr  i teCintSf i le :  proc; 
if  nointfile  then 

re  turn; 
call  monl(  26  ,  .  d  iskoutbuf  f )  ; 
if  mon2(21,  .wfeb)  <>  0  then 
call  d  iskerr ; 
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call  monl( 26,80h) ;  /*  reset  dma  addr  «/ 
end  •itfr  i  teGintGf  i  le  ; 

emit:  proc( objcode) ; 
del  objcode  byte; 

if  (bnffptr  :=  buffptr+1)  >=  intrecsize  then 
/*  vrr  i  te  to  disk  »/ 
do  ; 

call  wri teGintOf i le ; 
buffptr  =  0; 
end ; 
d iskoutbuf f ( buf f ptr)  =  objcode; 
e  nd  emit; 

generate:  proc( objcode) ; 
del  objcode  byte; 

codes ize  =  codeslze+1; 
call  emi t( objcode) ; 
end  genera  te ; 

c loseGintGf i le :  proc ; 

/*  closes  a  file  */ 

if  mon2( 16, .wfcb)  =  255  then 
call  d  iskerr ; 
end  c loseSintSf i le ; 

openSsourcef i le :  proc; 

call  move( . 'pas' , rf cbaddr+9 , 3) ; 
rfcb(32) ,rfcb( 12)  =  0; 
if  mon2( 15 , rf cbaddr)  =  255  then 
do; 

call  print(.'no  source  file  S'); 
go  to  boot; 
end ; 
end  OpenSsourcef i le ; 

rewindOsoiirceGf  i  le  :  proc  ;      /*  cp/m  does  not  require  any  action  */ 

return;  /*  prior  to  reopening  */ 

end  rewindSsourceSf i le ; 

readSsourceSf i le :proc  byte; 

dc 1      dent  byte ; 

if    (dent :=mon2(rf ile,rfcbaddr))    >    fileeof    then 
call    diskerr; 

re  turn    dent ; 
end    readGsourceGf i le ; 

crlf:  proc; 

call  pr intchar(  cr)  ; 

call  pr intchar(  If )  ; 
end  crlf; 

prlntdec:  proc(value); 

del      value  addr,  i  byte,  count  byte; 

del      deci(4)  addr  ini t ia 1(  1000,  100,  10. 1) 5 

del      flag  byte; 

flag  =  false; 

do  i  =  0  to  3; 

count  =  30h; 

do  while  value  >=  deci(i); 
value  =  value  —  deci(i); 
flag=  true; 
count  =  count  +1; 
end; 
if  flag  or  ( i>=  3)  then 

call  pr intchar( count) ; 
e  Ise 
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call  printchar(' 
end ; 
return; 
end  printdec; 


pr  intOprod : proc ; 

call  print(.'  prod  =  S'); 

call    pr  iatCdec<  produc  t Ion)  ; 

call    cr  If ; 
end    printSprod; 


printStoken: proc  ; 

call    print(.*     token    =    1 
call    pr intCdec( token) ; 
call    cr 1 f ; 

end    printStoken; 


clearSlineSbuff: proc  ; 

call    f  ilK  .  linefauff  ,  '     '  ,conbuf  fs  ize)  ; 
end    c learGl ineGbuf f ; 


listline:     proc ( length) ; 

del  (length,!)     byte; 

call  pr intSdec( 1 ineno) ; 

call  printCchar('  '); 

do  i  =  0  to  length; 

call    printchar( linebuf f  (  i) ) 

end ; 

ca  1 1    cr If ; 
end    1  is  1 1 ine ; 


/«*«  parser  variables  ***/ 

del  listprod  byte  ini t ia 1( f a Ise) , 

lowertoupper  byte  ini  t  ia  1(  true  )  , 

listsource  byte  ini t ia 1( f a Ise) , 

debugln  byte  ini t ia 1( f a Ise) , 

listtoken  byte  ini  t  ia  1(  f  a  Ise  )  , 

compiling  byte; 


/***  scanner  procedures  ***/ 

getchar:    proc    byte; 

del    addeof    data    ('eof,    eolchar,lf);    /*    add    to    end     if     left    off    «/ 

nextSsourceSehari    proc    byte; 

return   sourcebuf f ( sourceptr) ; 
end    nextSsourceSchar ; 

checkfile:     proc    byte; 
do    forever; 

if    ( sourceptr : =sourceptr+l) > =cursourcerecs ize    then 

do; 
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soiirceptr  =  0; 

if    readCsourceGf ile=f ileeof    then 
return    true; 
end ; 

if    (  nestchar  :  =nextOsourceOcliar)<>  1  f    then 
return    false; 
end  ; 
end    checkfile; 

if    checlifile    or    (nextchar    =    eoffiller)     then 

^'^  '  /*    eof    reached    */ 

call    move( . addeof ,sb loc , 5) ; 
sourceptr    =    0; 
nestchar=nextSsourceSchar ; 
end ; 
linebuf f ( 1 ineptr:= lineptr    +    l)=nextchar;  /^output    line*/ 

if    nextchar       =    eolchar       then 
do  ; 

1 iueno    =     line no    +    1; 
if     listsource       then 

call     listline(lineptr-l); 
lineptr    =    0; 
call    c  lear 1 inebuf f ; 
end; 
if    nextchar    =     tab     then 

nextchar    =     '     ' ; 
return   nextchar; 
end    ^etchar; 

getnoblank:    proc ; 

do    whi le( ( ge tchar    =     '     ' )    or    (nextchar    =    eoffiller)); 

end ; 
end    getnoblauk; 


title:proc;  /*   compiler    version   */ 

ca  1 1    cr 1 f ; 

call    printC  .  '  toggrles    setS'); 

ca  1 1    cr If ; 

call  pr int( . ' pasca l-m  vers  1.0S'); 

call  cr If ; 

ca  1 1  cr 1 f ; 
end  t  i  t  le  ; 


pr  intSerror : proc ; 

call  pr intdec(errorcount) ; 

call  printchar('  *); 

call  pr int( . ' error( s)  detectedS') 

call  cr  If ; 
end  prlntSerror; 


error:  proc( errcode) ; 
del  errcode  addr, 
i        byte; 
errorcount=errorcount+l ; 
call  print( . '**«S' ) ; 
call  pr intSdec( 1 ineno) ; 
call  print(.'   error  S'); 
call  printchar('  '); 
call  pr intchar( high( errcode) ) ; 
call  pr intchar(  low(  errcode) )  ; 
call  print(.'  near  S'); 
call  printchar('  '); 
do  i  =  1  to  accum; 

call  pr intchar( accum(  i)  )  ; 
end ; 
ca  11  cr 1 f ; 
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call    print(.'at    error    S 
call    printchar('     '); 
call    pr intGtoken; 
call    printC.'at    error    G 
call    printchar('     '); 
call    printSprod; 
if    token=eofc    then 
do; 

call    printQerror; 
call    mo  ti3 ; 
end ; 
end    error; 


ini t ia 1 izeOscanner :    proc; 
del    count    byte; 
call    openGsourcef i le ; 
1 ineno , 1 ineptr    =    0; 
call    clearGl ineGbuf f ; 
sourceptr    =     128; 
call    getnoblauk; 
do    *dii  le    nextchar    =     'S'; 
call    getGnoGblank; 

if    (count     :=    < next char    and    5fh)    -    'a')     <=    4    thei 
do    case    count; 

listsource    =     true; 
1  is  tprod    =     true ; 
nointfile    =     true; 
list  token    =     true; 
debugln    =     true; 
end;  /■*   of    case    */ 

call    g^etnoblank; 
end ; 
end    ini t ia 1 izeGscanner : 


/  ^\  SjC  Jf*  3f»  Jf*  JjC  3(C  *|C  3f»  ?|t  ^s  'I^  'f*  'r*  ***  *^  ^*  'f*  ^f*  *?*  'S  'S  'T'  'T*  *!*  •¥*  '**  «!*  'f*  •S  'I'  *?*  *<^  'T*  'P  ^^  **»  •?*  *P  'I'  'I*  *(*  'o  't^  'S  ^T^  'c^  'o  m^  'J^  'I*  't'  'I'  'i^  '1^  'o  W*  'i*  'f*  'i^  *?*  'I*  ^N  'T*  *!*  'K  'i*  'I^  't^  •?*  / 

/*5!J*  scanner  **«/ 

y  «2#  «^  «Ji>  «^  *£>  ^>  ^k^a'  ^^^j*  «£*^M^^^U«At  ^»^«^U^w^U^U«i^«J«t^O*^i*«^^*^*^*K^«l*  «lr  tl#  ^  ^  a^  ■^*J'^'  ^  ^^  •^^^  "Jf  ^k  ^^  ^r  ^*  ^S*  ^>  ^^  «^  ^*  <^  ^>  «{*  ^a  ^^  ^  ^»^UO^^^^y  ^^^l*  vl^  *^  *2>    ^ 

^  ^s  ^^  <^  <^  Jf*  ^^  «^  <^  ^^  ^^  «^  ^^  ^^  ^>  ^%  ^>  ^^  ^^  ^>  «JV  vpt  ^>  «^  ri^  ^>  if*  ^%  •!%  ^^  *i*  ¥f*  ¥fs  «T*  jt*  'T*  ^>  'T^  *i^  'T^  'T*  ^^  'f^  mV  'T^  'I*  'I*  *t*  *t*  *(*  ^^  't*  'T*  'T*  ^^  *J^  *t*  'f*  *?*  ^>  ^  *^  '^  n*  *^  ^*  ^f*  *t*  *t*  '^  ^  / 

^  ^U  ^k  ^^  ^k  ^ir  ^*  ^U^^^^^»  «^^»«^^^k^  *i^sl^^^  ^*  *1*^>  *i^  ^S'^'  ^^%^%l^*^»J^^^tJ*sht^lf  *lf  %^  *if^^  *if  *Jf  ^  *if  ^*  s^^  ^#  ^i*  %^  ^u  ^u  ^>  ^  *i^^S*^^  ^^  >lf  ^^4*  *V4*  ^^  ^^  ^^  ^^  ^u  ^>  ^*  ^^^'^^   / 
X^  ^>^^^^  ^S*^  ^^«^^^<^  ^  ^>^^  v^^^^>  (^^^^S^>  ^*  ^^^rf^^^^^  ^  *f\  ^•9  ¥f*  ^*  ^*  ^*  ^t  ^^  ^^  aX*it*^*'t*'f*^*  ^**T»*T**T*  ^»'Ii^*^w'^  *J»  *^  *T*  *r»  ^>  «T««|^«T**^  '^^^H^  n^*^^^  M»*^  ^»  'V**f*y 

scanner:  proc; 

del  flag  byte; 

putinaccum:  proc; 

if    not    cont     then 
do; 

accumC accura    :=    accum  +    1)    =    nextchar; 
hashcode    =    ( hashcode+nextchar)    and    hashmask; 
if    accum   =    31     then   cont    =     true; 


end ; 
end    put  inaccutn; 


putandget:  proc; 

call  put inaccum; 

call  getnoblank; 
end  putandget; 


putandchar:  proc; 

call  put inaccum; 

nextchar  =  getchar; 
end  putandchar; 


numeric:  proc  byte; 

re turn( nextchar  -  '0')  <■ 
e  nd  nume  r  i  c ; 
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lowercase:    proc    byte; 

return    ( nestchar    >= 
end     lowerOcase; 


61h)    and    (nextchar    <=    7a h)  ; 


dec ima Ipt : proc    byte; 
return   nextchar= 
end    dec  ima Ipt ; 


convStoSupper : proc ; 

if    lowercase    and    lowertoupper    then 
ne2tchar=nextchar    and    5fh; 
end    convStoGupper ; 


letter:    proc    byte; 

call    convS to Supper ; 

return    ((nextchar    -    'a')    <=    23)    or    lowercase; 
e  nd    letter; 


alphanum:    proc    byte; 

return    numeric    or    letter 
end    alphanum; 


spoo Inumer ic :    proc; 

do    while    numeric; 
call    putandchar; 

end  ; 
e  nd    spool nume  r  i  c ; 


setupSnextScal 1 :    proc; 

if    nextchar    =     '     '     then 
call    getnoblank; 

cont    =    false; 
end    se tupSnextSca 1 1 ; 


lookup:    proc    byte; 

del    maxrwlng    lit       '9'; 

del    vocab    da ta(0,'.','<*,'(','+','S', '*•,')•,';'»'-•, '/",',','>• 
','  =  ','..','(*','>«)•.•:  =  ',  'do'  ,'  if ',♦  in'  ,  'of  ,  'or'  ,  'to'  ,  'eof  • 
'and' ,  'div'  , 'end' ,  'for' , 'mod'  , ' ni 1 ' , ' no t ' ,  ' se t '  ,  ' var '  ,  'case' 
'else' , 'file' , 'go  to' , 'read' , ' then' , ' type ' , ' wi  th'  , 'array' , 'begin' 
'const'  , '  label'  ,  ' unt  i 1 '  ,  ' whi le ' ,  ' wr  i  te '  , ' down  to '  ,  ' packed ' 
readln'  , 'record'  ,  ' re pea  t ' ,  ' <  empty> ' ,  ' program'  ,  ' wr  i  te In' 
, ' f unc  t  ion' , ' procedure ' ) ; 

del    vloc    data(8, 1, 15,35,65,97, 132, 162, 183, 191,200) ; 

del  vnum  da ta( 0, 1 , 15 , 25 , 35 , 43, 50, o5 , 60, 6 1) ; 

del  count  data(0, 13,9,9,7,6,4,2,0,0) ; 

del  ptr  addr,  (field  based  ptr)  (9)  byte; 
del  i  byte ; 

compare:  proc  byte; 

dc 1  i  byte ; 

i  =  0; 

do  while  (field(i)  =  accum(  i 

end ; 

return  i  >  accum; 
end  compare; 


i  +  D)  and  i  < 


accum; 


if  accum  >  maxrwlng  then 
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return    false; 
ptr= vlocCaccum) +. vocab; 

do     i  =  vnum(accum)     to    (  viiura(  accum) +count(  accuni)  ) 
if    compare    then 
do; 

t  o  ke  n=  1 ; 

if    i    =    53    then 

/*  the  following  code  sets  up  storage  fl  «/ 
/*  pointers  for  record  entries  in  the  */ 
/*    symbol     table.  ^/ 

do ; 

recSns  t  =  recGns  t+1 ; 

aptraddr ,recQparGadr(recCns  t) =sbtbl; 
addrptr=O0O0h: 
aptraddr=aptraddr+2; 
addrptr=prvSsbtb 1 Gentry; 
prvSsbtb 10entry=sbtbl ; 
aptraddr=aptraddr+2; 
byteptr= Ifh; 
sbtbl=sbtbl+9; 
/=!:  record  ini  t  iaza  t  ions  */ 

var iantOpar t(recCns t) , tagOf d( recSns t ) = f a Ise ; 
fxdCofs tGbse(recGns t) =OO00h; 
varGofs tGbse(recGnst) =O0O0h; 
curGofst(recOnst)  =0<90Oh; 
varGcasGva 1 ( recSns  t ) =0000h; 
recordGptr=-  1 ; 
end ; 

return  true; 
end ; 
ptr=ptr+accum; 
end; 

re  turn  fa  Ise  ; 
end  lookup; 


^  ^%  ^X  Jf*  Jf*  ^^  ^*  ^>  »T*  "^  ^^  ^*  ^^  *r*  'r*  "^  'I*  't*  ^S  *?*  ^  *^  ^*  rf*  'T*  •^  ^>  rf*  *^  *1*  ^»  >r*  *?•  ^T*  'f*  *T*  "T*  'F*  *f*  ^»  'I*  •!*  'T*  •T*  '«*  'C*  ^>  *!•  't*  "T*  •?*  *i*  ^»  '^  *?*  ^>  "T*  "N  ^>  '!•  ^*  ^  ^^  ^  ^  ^  ^  *!*  ^S  'S  ^  / 

/5j*5(S  !f»  3(C  5fC  3s 'o 'l^  *!*  •?■  3i*  y  Jt*  ^  *(»  JjC  JjC  5s  Jf*  *?»  *iC5jC»r*'N'r* '(^'t^'TC5r*5jC5jt5iC5rC5rt  *^5rC5iC5r»*iC*|»5tC  ^>TC^>iC7jv/^!f!'fCrS<CXr!'K^'o '7^^'T^'f^'i^'^  y  JfCJlCJfC/ 

/**5f:  scanner    -    main         code  ***/ 

y  \V  «Lf  vw  *j,*  si*  *i«  ^L*  si#  s^  ^v  *^  ^^  *t^  *^  *^  *^  *^  ^^  ^'  ^t*  >^  ^^  ^  "^  ^  ■i^  "^  *^  ^  N^  >^  ^t^  *tf  y^  y^  ^  ^^  ^^  ^  ^  ^  ^  *^  ^^  ^^  ^S*  ^f*  ^^  ^^  ^^  ^i*  ^*  Stf  4*  4*  ^i*  ^E*  *^  *if  *^  4*  4*  ^t*  ^l*  ^^  ^*  ^l*  *ht*  sC'  ^I*  ^ 

^    if*  j^  ^  ^  ^>  «^  ^^  *^  *^  ^»  ^^  ^^  *|H  •^  •^  ^S  ^>  ^N  ^^  ^*  ^>  ^*  'T*  ^^  '^  *f*  'I*  •T*  '^  '^  *t*  *T*  'T*  'T»  'r>  't*  'T*  *T*  "T»  "I*  W*  't*  'V*  n^  •I*  ^  '^  '^  '^  '1^  ^^  •^  •^  <?•  *¥•  ^P  ^*  ^P  "^  'J*  ^S  ^S  ^t*  *i*  *^  ^*  *t*  'f*  *%>  *%>  ^ 

/^  3|C  3f»  3|C  3|C  ^C  3f!  Jf!  If!  3(»  3(»  3f»  Jf*  *T»  3|C  #|C  3^  3|C  3f»  TfC  3|»  ?ih  5(5  3(C  3(?  3^  *f*  Jj*  3f*  *f»  *^  Sf5  *(%  ^t  5f»  J(»  JJs  3(»  •f*  *J*  JJt  Jiv  Sfi  *^  3(>  *^  *Jt  3|*  *|*  *J\  Jj?  3j*  *J?  »t*  '(^  3i*  ^t*  ^^  n^  'P  "T*  *»*  3(?  9|C  S|»  3fC  3f5  SjC  3J*  Sf*  5f»  / 

do    forever; 

accum,     hashcode,     token    =    0; 

do    while    nextchar=eo Ichar ; 

call    getnobla nk ; 
end  ; 
if    (nextchar    =    stringdelim)    or    cont    then 

do;  /=.-    found    string    */ 

token    =    stringc; 
cont    =    false; 
do    forever; 

do    while    getchar    <>    stringdelim; 
call    putinaccum; 
if    cont     then   return; 
end  ; 

call    getnoblank; 
if    nextchar    <>    stringdelim    then 

re  turn; 
call    putGinSaccum; 
end;  /*  o f    do    forever    */ 

end;  /*    of    recognizing   a    string   */ 

else    if    numeric    then 

do;  /*   have    digit    */ 
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token    =    numberc ; 

typenuin    =     integerGtype ; 

do    while    ne:itchar=  '  0'  ;    /*e  1  ira    leading   zeros*/ 

ne  X  t  c  ha  r  =  ge  t  c  ha  r  ; 
end  ; 

call    spoo Inumer ic ; 
if    decimalpt    then 
do; 

call    putandchar; 
typenura   =    realStype; 
call    spoo Inumer ic ; 
e  nd ; 
/*    this     takes    care    of    expon.     form   */ 
if    nextchar    =     'e'     then 
do: 

typenum   =    uns ignSexpon; 
call    putandchar; 

if    nextchar    =     '-'    or    nextchar    =     '+'     then 
do  ; 

call    puta nd c ha r ; 
typenam   =    s  ignedGexpon; 
end ; 
call    spoo Inumer ic  ; 
end ; 
if    ace urn    =    0    then 

hashcode ,accum( accum!  =  1)     =     '0'; 
call    set  upGne  x  t  Gc  a  1 1 ; 
re  turn; 
end;  /*    of    reco^^nizing   numeric    constant    */ 

else     if     letter    then 

do;  /«   have    a    letter    */ 

do    while    alphanum; 

call    putandchar; 
end ; 

if    not     lookup    then 
do ; 

token    =     identifier; 
call    se tupGnextGca 1 1 ; 
re  turn; 
end; 
else  /*    is    a    rw  but     if    comment    skip    */ 

do; 

call    setSupSnextScal 1 ; 
return; 
end; 
end;  /*    of    recognizing   rw  or    ident    */ 

else  /*    special    character    */ 

do; 

if    nextchar    =    ands ign    then 
do; 

nextchar    =    getchar; 

do    while    nextchar    <>    ands ign; 

nextchar    =    getchar; 
end; 

call  getSnoSblank; 
end ; 
c  Ise 
do ; 

if    nextchar    =    ':'     then 
do ; 

call    putandchar; 
if    nextchar    =     '='     then 
call    putandge t ; 
end; 
e  Ise 

if    nextchar    =     '.'     then 
do; 

call    putandchar; 
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if    nextchar    =     '.'     then 
call    putandget; 

e  Ise 

if    numeric    then 
do  ; 

token   =    numberc    ; 

typenuiu    =    realOtype; 

call    spoo  liiUiner  ic     ; 
/^    check    for    exponent    */ 

if    nextchar    =     'e'     then 
do ; 

t  ype  num=  uns  i gnSe  xpo  n ; 
call    putandchar; 

if    nextchar    =     '-'    or    nextchar    =    '+'     then 
do ; 

typeaum=s  ignedSexpon; 
call    putandchar; 
end  ; 
call    spoo Inumer ic ; 
end; 

call    se tCupSnextGcal 1     ; 
re  turn; 
end  ; 
end; 
e  Ise 

if    nextchar    =     *('     then 
do  ; 

call    putandchar     ; 
if    nextchar    =     '*'     then 
call    putandget; 
end ; 
e  Ise 

if    nextchar    =     '*'     then 
do ; 

call    putandchar    ; 
if    nextchar    =     ')'     then 
call    putandget     ; 
end; 
e  Ise 
call    putandget; 

if    not     lookup    then 

ca 1 1    errorC ' ic ' ) ; 
call    se tupCnextScal 1 ; 
re  turn; 
end; 
end;  /*    of    recognizing'   special    char    */ 

end;  /*   of    do    forever    */ 

end    scanner;  /*    end    of    scanner    */ 

/***  procedures    for    synthesizer  ***/ 

ini t ia 1 izeSsymtb 1 :    proc ; 

del  symbase  addr; 

do  ; 

cal 1     f il  1(  .hashtable,0,shl(hashtblsize,2) )  ; 

symbase= . ini  tSsymbStb 1 ; 

sb  tb 1= . memory; 

ini  tSsyrabStbK  15)  =high(  symbase)  ; 

ini  tSsymbStb 1(  16)  =  lowC symbase) ; 

ini  tSsymbStbK  25)  =high(  symbase  +  13)  ; 

ini  tSsymbStb  1(26)  =  low(  syml>ase+  13)  ; 

ini tSsymbGtb 1(35) =high(symbase+23) ; 

ini  tSsymbStbK  36)  =  lo>r(  syinbase+23)  ; 
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initSs7inb0tbl(48)=high(syral)ase+33) 
ini  tCs7ini)Ctbl(49)  =  lo\<?(  syinbase+33) 
ini  tSsymbStbl(59)=hisli(synil)ase+46 
initCsymbCtb  1(  60)  =  low(  syinbase+46) 
ini  tSsymbStb  1(71)  =higli(  symbase+57) 
ini  tCsymbOtb  1(72)  =  low(  synibase+57) 
initCsyiEl)Gtbl(85)=high(synibase  +  69) 
ini  tSsyabOtb  1(  88)  =  loxv(  symbase  +  69) 
hashtable(  14)  =syinbase ; 
liashtable(36)  =syinbase  +  13; 
hash tab le(30) =symbase+23; 
ha3htable(0)  =s^'TObase+33; 
lia3htable(  16)  =syinbase+46 ; 
hashtable(  1 13)  =syinbase+57; 
hashtable(64)  =synibase+69; 
hashtable(  107)  =syinbase+83; 
prvCJsb  tb  lOentry    =    symbase+83; 


end  ; 

sbtb  1  top=inax-2; 

vecptr  =  0!    cons  top tr  =  0; 

c  o  ns  t  S  i  nd  x=  0 ; 

cons  tSpnOptr  =  0; 

snbr0ptr=8; 

aryOdmSadrGptr=- 1 ; 

arrySptr=- 1 ; 

var  iantGpar  t=  f a Ise ; 

arrySqty=0; 

a  1  locGaddr  =  0; 

end    ini t ia 1 izeOsymtb 1 ; 


/***  parser  *«*/ 

/  3^  5|^  5fC  *fC  5|C  3^  3|C  5f*  5jC  JfC  JfC  ^  JjC  !^  5|C  Jp  SfC  3|^ 


do ; 
del 


/*   block   for    parser    «/ 


state    statesize, 

var( ps tacks ize)    byte, 

hash( ps tacks ize)  byte, 

varc ( varcs ize )  byte, 

var index  byte, 

s ta tes tack( ps tacks ize)  statesize 

(  sp, mp, mppl , no  look)  byte; 


/^ 


del 


nmumo  n i c  s    ) 

or    p 

ascal- 

5m   D 

lacuin 

le    ^^ 

endp 

lit 

•  1' 

,  Ibl 

lit 

'2' 

,nop 

.0. 

,ldib 

'3', 

Idii 

lit 

'4' 

,cnvb 

lit 

'9' 

,cnvi 

•  10' 

,all 

'  11'  , 

llta 

lit 

•  12' 

,addb 

lit 

'13' 

,addi 

'  14' 

,sub  i 

•  16', 

mul  i 

lit 

'  18' 

,divi 

lit 

'20' 

,  Iss  i 

•22' 

.  leqi 

'24'  . 

eqlb 

lit 

•25' 

,eqli 

lit 

'26' 

,  neqb 

•28' 

,neqi 

'29'  , 

geqb 

lit 

'31' 

.Seqi 

lit 

'32' 

.ffrti 

'34' 

.negrb 

'35'  , 

negi 

lit 

'36' 

,  c  o  mb 

lit 

'37' 

,comi 

'38' 

,no  tx 

'39'  , 

andx 

lit 

'40' 

,bor 

lit 

'41' 

,s  tob 

'42' 

,stoi 

'43'  , 

s  to 

lit 

'44' 

,stdb 

lit 

'45' 

,stdi 

'46' 

,std 

'47', 

dcrb 

lit 

'48' 

,dcri 

lit 

'49' 

,  dcr 

•50' 

,brl 

'52'. 

blc 

lit 

'53' 

,  lod 

lit 

'55' 

,lodb 

'56' 

,  lodi 

•57'  . 

rdvb 

lit 

'58' 

,rdvi 

lit 

•59' 

,  rdvs 

•60' 

,  wi'vb 

•61'  , 

wrvi 

lit 

'62' 

,  wrvs 

lit 

'63' 

,cna  i 

'51' 

,cn2l 

'54'  , 

dump 

lit 

'64' 

•  grtb 

lit 

'33' 

,  Issb 

lit 

'21' 

,  leqb 

lit 

•23'  , 

mulb 

lit 

'  17' 

,divb 

lit 

'  19' 

; 

ini t ia 1 izeGsynthes ize 5  proc  : 

codesize  =  0; 
end  ini t ial izeGsynthes ize ; 
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/***  code  generating  procedures  ***/ 

synthesize:  proc  ;  /.•;<  syntheaize  local  dsc  lai-a  t  ions  */ 

setaddrptr:  proc( of f se t ) ; 

dc 1  o  f f se  t  byte ; 

aptraddr  =  base  +  offset; 
end  setaddrptr; 

calcGvarc!  proc<a)  addr; 

dc 1  a  byte; 

return   var(a)    +    . varc ; 
end    calcQvarc; 

setlookup:     proc(a); 

dc 1    a    byte ; 

printnaine    =    ca  lc3varc  (  a)  ; 

symhash.   =    hash(a)  ;    /*    hashcode    of    pn   */ 
end    se  t lookup; 

/*  enterOlinliS    -    tkis    procedure    enters     in    the  */ 

/*  next    four    bytes    of    the    symbol     table    the  */ 

/*  collision    field    and    the    previous    symbol  */ 

/«  table    entry   address    field    for    the    next  */ 

/*  symbol    table    entry.    (    both    in   address    var  )    */ 

J  \i^  *i^  ^l'  s£*  «1*  ^I*  "^  «i*  *^  « ''  *i^  *t^  *i^  >1*  ^*  ^t*  *£*  *tf  ^j'  *^  ^ti*  *if  *A*  ^i*  ^^  ^t^  ^t'  *!'  ■^  ^X*  4^  ^^  ^S*  *i^  *£*  ^*  ^^  ^^  ^^  ^J<  *<(*  ^£*  ■^  *if  ^i^  *^  *^  ^k  ^ 

enterSlinks:  proc; 

base , aptraddr  =  sbtbl; 

addrptr  =  hashtab le( symhash) ; 

call  se taddrptr( 2) ; 

addrptr  =  prvSsb tb ISentry; 

prvSsbtblSentry  =  sbtbl; 

hashtab le  (  symhash)  =  base; 
end  enterSlinks; 

checkSpr intSname :  proc(a)  byte; 

/*  a  is  offset  from  base  to  printname  */ 

dc 1  n  based  printname  byte; 

dc  1  (  len, a)  byte ; 

call  se taddrptr( a) ; 

if  (  len  :=  byteptr  )  =  n  then 

do  while  ( bytep tr(  len) =n(  len) ) ; 

if  (  len  :=  len- I  )  =  0  then 

return  true; 

end ; 

re  turn  fa  Ise ; 

end  checkSpr intSname ; 

/*:(:***********«*********«************************/ 

/*  lookupSpr intnameSident i ty  -  this  procedure  */ 

/*   is  passed  the  location  of  an  identifier  in  */ 

/*   the  production  rule,  and  its  target  entry  */ 

/*   type,  if  the  identifier  is  found  with  the  */ 

/*   correct  type  the  procedure  return  true,  */ 

/«   else  false  is  returned.  */ 

lookupSpnSid:  proc( a , idSentry)  byte; 
del  (a, idSentry)  byte; 
call  setioo kup ( a ) ; 
base  =  hashtab le( symhash) ; 
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do  while  base  <>  0; 
call  se taddrptr( 4) ; 

if  ((  byteptr  and  formmask  )  =  idSentry  )  then 
do ; 

if  checkSpr intOname( 5)  then 
lookupSaddr=base ; 
return  true; 
end  ; 

e Ise  do ; 
call  se taddrptr( 0) ; 
base  =  addrptr; 
end ; 
end ; 
return  false; 
end  lookupSpnSid ; 


/*  limits  -  this  procedure  ensures  that  the  */ 

/*  symbol  table  entry  about  to  be  entered  */ 

/*  will  not  exceed  the  upper  limit  of  the  */ 

/*  available  symbol  table  addresses.  */ 

/*  the  parameter  is  the  bytecount  of  the  */ 

/5^  entry  to  be  entered.  */ 

limits:  proc(count); 
del  count  byte; 

if  sbtbltop  <=  (sbtbl  +  count  )  then 
do  ; 

call  error( ' to  * ) ; 
call  mo  n3 ; 
end ; 
end  limits; 


^  ^t  ^»  ^t  ^^  ^s  if^  )/^  ^^  ^  Jf»  ^x  y(t  ^t  J^  if*  ^t  *(v  ^»  /^  ^s  tf^  y^  J^  #iv  S^  JJ*  ^v  3^  ^t  *H  Jjv  Jj*  3|s  ^%  JjC  *I?  7^  #f»  3j»  tft  ^S  'J*  'i*  •o  3o  ^^  »f*  *!*  / 

/"*  enterSpr  intnameSident  i  ty  -    this    procedure  */ 

/*  loads    the    symbol    table    with    the    following:  */ 

/*             1.     collision    field  */ 

/*           2.    previous    symbol    table    entry  address  */ 

/*            3.     form   of    entry    (     preset    byte     "form"    )  */ 
/*            4.     the     length   of    the    printname     in    one    byte*/ 

/*           5.     the    printname    characters  */ 

/*  parameter:    printname     is    set    prior    to    call.  */ 

/  ^  ffC  aft  <(C /f(  ?fC  «f«  «f*  3f*  ^  SlfC  ^  3fC  rf!  «}v  ^S  ^  f^ 

enterSpnSid : proc ; 

del  (i,n  based  printname)  byte; 

call  1 imi ts(  i : =n+6) ; 

call    enterSlinks; 

call    se taddrptr( 4) ; 

byteptr    =     form; 

call    se taddrptr( 5) ; 

byteptr=n; 

call    mo ve( pr  intuame+ l,sbtbl+6,n)  ; 

sbtbl=sbtbl+i; 
end    enterSpnSid; 


/'******:<;**sfc****«***********************5(c****'i«****/ 

/*  enterSvar iableSident i ty   -    this    procedure            */ 

/*  calls    enterSpnSid    to     load    the    symbol     table    */ 

/«  entry   currently   being   scanned,     it    also               */ 

/«  generates    the    entry's     "form"    by   performing   =*=/ 

/«  a    boolean    ' or '    opera t ion   on    the     idSentry         */ 

/*  and    the    parameter     "a".                                                           */ 

enterSvarSid:     proc(a,b, idSentry) ; 
del    (a, b, idCentry)    byte; 
if     lookupCpnOid( b, idSentry)     then 
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re  turn; 
/*    else    enter    var    name    */ 
form    =    a    or    idGentry; 
call    enterGpnGid ; 
end    enterGvarSid; 


/^      setGlabel    -    this    procedure    assigns    a    label      */ 
/*  to     the    current    declared     label    and    increment*/ 

/*  the     labe Icount    (     next    to    ass  ign    )  .  */ 

/,•;;***«***>!;  :f:***','c***«;rJ*5fc**««***«***********3C*«***«*/ 


setSlabel:    proc ; 

addrptr= lab Icount ; 

lab Icount = lab lcount+1 ; 
end    setSlabel; 


/*  enterGlabel  —  this  procedure  loads  a  label  */ 
/*  entry  into  the  symbol  table,  symhash  and  */ 
/*         printname    must    be    set    prior    to    calling  «/ 

enterSlabel:    proc; 

call     limits(2); 

aptraddr  =  sbtbl; 

ca  1  1  se  tGlabe 1 ; 

sbtbl    =    sbtbl+2; 
end    enterSlabel; 


/*  lookupSonly   —    this    procedure     is    passed    the       */ 

/*  position   of    a    identifier    Just    scanned    in         */ 

/«  the    current    production    (    sp,mp,mppl    )    and       */ 

/■'.'  returns     true     if    the     identifier    is    found    in   */ 

/*  the    symbol     table.                                                                           */ 

lookupSonly:    proc(a)    byte; 
dc  1    a    byte  ; 
call    se t lookup( a) ; 
base=hashtab le( symhash) ; 
do    while    base    <>    0; 
if    checkSpr intCname(5)     then 
do  ; 

lookupGaddr  =  base  ; 
return    true; 
end ; 
e Ise    do ; 
call    se taddrptr( 0) ; 
base=addrptr ; 
end ; 
end ; 
return    false; 
end    lookupSonly; 

convrtbcd:    proc(a,b);    /*   a  =  sp/mp/mppl ,    b  =  pos/neg   */ 

/«  this  procedure  converts  a  real  */ 
/*  number  in  the  program  to  a  bed  */ 
/*         representation.  */ 

del    ( i, J ,df lag.ef lag,sf lag,a,b,n   based    printname)    byte; 
del    (  expo n loop, exps ign loop)     label; 

call    se t lookup(  a)  ; 
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/*       Initialize    variables    */ 
3flag=false;     eilas=true;     dflagr=true;     i=l; 
do    J=0    to    7;     bcdnum(j)=0;    end; 
j=3;    espon=64;    /^   e+00    */ 

/*    remove     leading^   zeros    */ 
do    while    (  (n(  i)    -    '0' )     =    0)  ; 

i=i+l; 

if     i=(n+l)     then   goto    exponloop; 
end ; 

/*    load    bcdnum  with  significant    digits    */ 
do    while    ((n(i)     -    '0'     )     < =    9    or    n(i)     =    '.'); 
if    n(  i)     =     '  .  •     then 
do;    eflag=false; 

if     i=n    then   goto    exponloop; 
I    =     i    +     1; 
end ; 
e  Ise 
do; 
do    while    J    =    0    and    dflag   and    (n(i)    -    '0')    =    0; 
expon    =    expon-1; 
if     i    =    n    then   goto    exponloop; 
i    =     i    +    1     ; 
end ; 

if    J    =    (    bcdsize-1    )     then   goto    exponloop; 
if    dflag    then   /'^    first    bed    pair    */ 
do ; 

bcdnumC  J ) =ro 1 ( ( n(  i ) - ' 0 ' )  . 4)  ; 
dflag=false;     i=     i+1; 
if    eflag    then   cxpon=expon+l ; 
end ; 
e  Ise 
do; 

bcdnum( j)=bcdnum( J )+(u(  i)-'0')  ; 
J    =    J    +    1;     i    =     i    +    1; 

dflag=true;     if    eflag    then   expon=expon+ 1 ; 
end ; 
if    i=(n+i)     then  goto    exponloop; 
end  ; 
end;  . 

exponloop: 

if    i    =    ( n+ 1)     then   goto    expsignloop; 
if    eflag    then 
do; 
do    while    n( i)    <>     ' . ' ; 
expon   =    expon   +    1; 
i    =     i    +    1; 
end ; 

i    =     i    +    1; 
end ; 
do    while     i    <     (n+1)    and    (n(i)-'0')    <=    9    ; 

i  =  i  +  1; 
end ; 

if  typenum  =  real  type  then  goto  expsignloop; 
/*  n( i)  =  e  */  i  =  i+1; 
if  typenum  =  s ignedOexpon  then 
do ; 

if  n(i)  =  minusx  then  sflag  =  true; 
i  =  i  +  1  ; 
end ; 
if   i  =  n+1  then 
do  ; 

call  error('ee*); 
re  turn; 
end ; 
dflag  =  0; 
do  J  =  i  to  n; 

dflag    =    (df lag*10)+(n(j)-'0') ; 
end ; 

if    sflag    then    /*    exponent    calculation    */ 
expon    =    expo n-df lag; 
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else    expon    =    ezpon   +    dflag; 

e  xps  i  gn.  loop: 

bcdnura(  bcdsize- 1)  =ro  1(  b,7)  ;    /Vt   sign   of    number    */ 
if    expon    >     127    then 
do  ; 

call    error('ee'); 
re  turn; 
end ; 
else    bcdnumCbcds  ize— 1)  =bcdnuin(  beds  ize-1)  +expon; 

end    convrtbcd; 

/"^  convert  i    -    this    procedure     is    passed     "a",     the*/ 

/*  location    of    a    constant     in    the    production         */ 

/S  and     "b"    the    'sign'    of    the     integer,     the              */ 

/*  function   genei-ates    a    signed     16    bit    repre-       */ 

/*  senlation    of    the    number    and    returns     it     in      */ 

/5f:  an    address    variable.                                                                */ 

converti!    proc(a,b)    address; 

del    (i,a,b,n   based    printnarae)    byte; 
dc 1    num   addr ; 

call    se t lookup( a) ;     num=0; 
do     i=  1    to    n; 

if    (maxint/10)     >=    num    then 
do; 

if    (maxint/10)    =    num  and    (n(l)-'0')    >    7    then 
do; 

call    error( ' ie ' > ; 
return    num; 
end ; 
num=(num*10)+(n(  i)-'0' ) ; 
end ; 
e  Ise    do ; 

call    error( ' ie ' ) ; 
return    num; 
end; 
end ; 

if    b    =    pos    then    return   num; 
if    num   =    maxint    then 
do  ; 

ea  11    error(  '  ie  '  )  ; 
return   num; 
end ; 
re  turn    (    -    num) ; 
e  nd    c  o  n  ve  r  t  i  ; 

/*  conver tGcons tant    -    this    procedure     is    called    */ 

/*  with    typenum   set    by    the    caller,     the    number    */ 

/*  must    be    pointed    to    by    "sp"     in    the    produc-       */ 

/*  tion.     the    procedure    returns    with    "constS         */ 

/*  numStype"    and    "cons tSva lue "    set    with    the         */ 

/«  number     in    its     internal    form.                                          */ 


convrtScons t :    proc(a);    /*    a=pos, neg   */ 
del    a    byte , intSaddr    addr; 

if    typenum   =     integerStype    then 

do  ; 

intSaddr  =  conver t i(  sp, a)  ; 

constSnuniStype(constSptr)  =  IntegerStype  ; 
constSptr=constSptr+l;  ^,     ,    s    o^ 

cal 1    move( . intSaddr, . cons tSvalue( cons tS indx) ,zy  ; 
constSindx=cons tSindx+2; 
end; 
e Ise    do ; 
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call    convrtbcdC sp, a) ; 

cons  tCniuuStypeCcons  tGptr)  =realStype; 
cons  tGptr  =  cons  tGptr+ 1 ; 

cal  1    move(  .bcdnmn,  .  cons  t  ova  lue(  cons  tSindx)  .beds  ize)  ; 
cons  tSindx=cons  tGindx+bcds  ize ; 
end ; 
end    convr tOcons t ; 

/■****  ^  *  *  *  *  5^  *«******:;;•■;:  ;,N :::  ;;< :;; ;;:  ^"J  *  ;,^  :,^ ;;;  rfc  >s  :S  >;;  5,': :;;  >ii  'l'.  ^ ;;; ;;:  Mc ;;:  * :;:  :.t  r:<  :-i  / 
/*  enterGcons  tantCnuaiber  -  after  the  next  entry*/ 
/*  has  had  its  links  entered  into  the  symbol  */ 
/^  table,  this  procedure  enters  the  constant  */ 
X^:         value     into    the    syjabol    table    and    set    the  */ 

/«         entry's     "form"    to    the    appropriate    type.  */ 


enterSconsSnumb ;    proc ; 

cons tOptr  =  cons  tGptr- 1 ; 

if    cons tGnumOtype ( cons tGptr) =     integertype    then 
do  ; 

call    se taddrptr( 4) ;    byteptr=8   or    consSentry; 
call     liinit3(2);    cons  tG  indx=cons  tG  indx-2 ; 
call    move ( .cons  tGva lue( cons  tG  indx) , sb  tb 1 , 2) ; 
sbtbl=sbtbl+2; 
end ; 
e  Ise    do ; 

call    se taddrptr( 4) ;    byteptr= 10h   or    consGentry; 
call     1 imi ts( beds ize ) ;    cons tGindx=cons tGindx-bcds ize 
call    ciove(  .constGvalue(constGindx)  ,sbtbl,bcdsize)  ; 
sbtbl  =  3btb 1+bcds  ize ; 
end ; 
end    enterGconsSniunb ; 

/)C;fC5f{:S*ifs***5S********>K********5S5f:**«**5<««***«*:f«**«***/ 
/*  enterCs  tr  ing  -  after  the  "  1  inlis  "  and  "form"  */ 
/*         are    entered    into    the    symbol    table,     this  */ 

/*  procedure  loads  any  identifier  along  with  */ 
/*  its     length,     (used    with   constant    strings  */ 

/*         and    constant     identifiers    )  */ 

/•*5C****>i{***************««**********«**5fC5f:5f:**5S*5fc***/ 


enterSg tr ing:  proc(a); 

del  (a,n  based  printname)  byte; 

call  se t lookup( a) ; 

ca 1 1  1 imi  ts( n+ 1 )  ; 

call    mo ve (print name, sbtbl,(n+l))  ; 

sbtbl=sbtbl+(n+l) ; 
end    enterSs tr ing; 

enterSconsGident :    proc(a,b);    /*    a  =  pos/'neg    ,    bsmp/mppl/sp    */ 
dc 1    ( a , b . c)     byte ; 

c  =  ro  1  ( a , 6)  ; 

call    setaddrptr(4) ;    byteptr=c    or    consSentry; 

call    enterGs tr ing(sp) ; 

cons  tGpnSptr  =  cons  tSpnSptr- 1 ; 

cons  tGindx=cons tSindx-cons tSpnGs  ize ( cons tSpnSptr) ; 
end    enterSconsSident ; 

enterScons tSentrys    proc; 
del     ixindex    byte; 
vecptr=vecptr-l; 
do    case    cons tSvcc( vecptr) ; 
/*    case    constant    number    */ 
call    enterGconsGnumb ; 
/%    case     identifier    constant    */ 
call    enterSconsGidentC pos ,sp) ; 
/*    case    signed    identifier    constant    */ 
call    enterSconsSident(  neg.sp)  ; 
/*-    case    constant    string    */ 
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do: 

call    setaddrptr(4) ;    byteptr= 13h   or    consGentry; 

call    enterGs tr ing( sp) ; 

cons  tOpnQptr  =  cons  tGpnGptr-1 ; 

cons  tGind:r=coastQindx-coristCpnCsize(  cons  tGpnCptr)  : 
end  ; 

end;    /*    of    case    constStype    */ 

end    enterGcons tCentry; 

/*  enterGcomplexGtype    -    this    procedure     is  «/ 

/*  called    to    enter    the     "lialis"    and     "form"    for  :!=/ 

/*  the     'complex    type'     symbol     table    entries.  :.':/ 

/*  note*    that    this    entry   never    has    a    print-  */ 

/*  name    assigned.  %/ 


enterOcompleTiGtype :    proc(a); 
dc  1    a    byte ; 

cal  1     1 imitsCS)  ; 

base,aptraddr=sbtbl; 

addrptr=000Oh; 

call    se taddrptr ( 2) ; 

addrptr=prvGsb tblGentry; 

prvGsb  tbl3entry=base ; 

call    setaddrptr(4); 

byteptr=a ; 

sbtbl=sbtbl+o; 
end    enterGcomplexGtype ; 

/*  enterGs true tOtype    -    this    procedure    is  */ 

/*  called    by    the     'type'    productions:  */ 

/*               1.    set     type  */ 

/*              2.     file    type  */ 

/'^.-              3.     pointer    type  */ 

/*  it    calls    enterCcomplexStype    to    set    up  its       */ 

/:.-  "lin^"    and     "forjn",     then    it    sets    a    pointer    «/ 

/*  to     the    associated    complex    type.  */ 


enterSs true tOtype :    proc(a); 
dc 1    a    byte ; 

call    enterGcomplexStype(  a)  ; 

call     1 imi  ts(2)  ; 

call    se taddrptr( 3) ; 

addrptr= typeCloc t ; 

sbtbl=sbtbl+2; 

typeSloe  t  =  base  ; 
end    enterGs true tGtype ; 

/*  lookupOident i f ier  -  this  procedure  is  called*/ 
/w;  with  'symhash'  and  prlntname  set.  it  will  */ 
/*         return    true    if    the    identifier    can  be    found    */ 


lookupGident :    proc    byte; 

base = has ht ab le( symhash) ; 
do    while    base    <>    0; 

if    checkGprintGname(5)     then 
do  ; 

lookupSaddr=base  ; 
return    true; 
end ; 
e Ise    do  ; 

call    se taddrptr(O) ; 

base=addrptr; 

end ; 
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end ; 
re  turn    f a  Ise ; 
end    lookups ident  ; 

/«!       lookupCpr  intnameSonly  -    this    procedure    sets    */ 

/*  the     "symhash"    and    calls     lookupSident    to  «/ 

/;."-         determine     if     the    entry    is     in    the    symbol  */ 

/:;:  table.        the    auuress    of    the    printnanie     is  */ 

/*         passed    as    a    parameter,     if    the    entry    is  */ 

/*         found,     true     is    returned.  */ 


lookupSpnSouly:    proc(a)    byte; 

dc  1    a    addr;    /*    addr    of    print-name    */ 
del    (b,n   based    a)    byte; 
hashcode=0; 
do    b=  1     to    n; 

hashcode= ( hashcode+n( b) )    and    hashmask; 
end ; 

symhash^hashcode ; 
pr  intname  =  a ; 
if    lookups ident    then 

return    true; 
else    return    false; 
end    lookupSpnSonly; 

/  ^«f  Stf  ^^  ^^  *^  ^it^ic  ^c  ^c  ^Jf  jk  ^tc  iic  ^tt  He  He  Ht  Hi  Hi  He  He  He  He  He  He  He  He  He  He  Ht  He  ^ic  S£  He  He  *^  HeHe  He  Hi  He  He  He  He  He  He  He  He  He  / 

/*      s toreScons tant     identifier    -    this    routine     is       */ 
/*         called    with   printname    set    to     load    an  */ 

/*  identifier     In    the     'constant    value'    variable.*/ 


s toreOcons tSident :    proc ; 

del    n    based    printname    byte; 

call    se t lookup(  sp)  ; 

call    move(printname,.constOvaliie(constSindx),(n+l)); 

cons tSindx=cons tSindx+(  n+1)  ; 

cons  tSpn$hash( cons  tSpnSptr) =symhash; 

cons  tSpnSs  ize( cons  tSpnSptr) =n+ 1 ; 

cons t8pn$ptr=cons t$pnSptr+l ; 
end    s toreScons tS ident ; 

subrSerrorJ    proc; 

call    errorC ' is ' ) ; 

subrStype(subrSptr)  =  integers type ; 

subrSval(subrSptr)=0000h; 
end    subrSerror; 

ordShiSlov/Scheck:    proc; 

if    subrGptr=0    then    return; 
if    subr3type  =  subrStype(  1)     then 
do; 

if    subrSval    >    subrSval(l)     then   return; 
end ; 
call    error( '  is ' )  ; 
end    ordOhiSlowScheck; 

subrSintShiSlowScheck:    proc; 
if    subrSptr=0    then   return; 
if    subrStype    <>    subrStype(l)     then 
do  ; 

call    subrSerror; 
re  turn; 
end  ; 
if    subrSval    <    32768   and    subrSval(l)    > 32767    then 
do; 

integerSdiff    =    subrSval+(    -subrSva 1( 1) ) + 1 ; 
re  turn; 
end  ; 
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if    subrGval    >    32767    and    subrSval(l)    <    32768    then 
do; 

call    subrSerror; 
re  turn; 
end  ; 
if    subrSval    < 32768    then   /*   both   positive    */ 
do; 

if (subrSval-(subrSval(  1)  +  1) )    <    32768    then 
do;     integerSdif f  =  subrSval-(subrSval(  1))  +  1; 

return; 
end  ; 
call    subrSerror; 
re  turn ; 
end; 
else    /*    both   negative    */ 

if    (     -    subrSvaK  l)-(    -    subrSval    +1))    <    32768    then 
do ; 

integrerffidif  f=(     -    subriSva  1  (  1)  ) -(    -    subrSval)  +  l; 
re  turn; 
end ; 
call    subrSerror; 
end    subrSintShiSlowScheck; 

/  3|C  SjC  !f«  ^  #f>  3(C  3f«  ifC  3f«  3f« 'j^  3|C  3^  3^  3fC /fC  ?f«  ^  2f^ 

/*  subrangeSident if erSprocedure    -    this    routine  */ 

/*  is    called    to    determine    the    offset    (     number  */ 

/*  of    entries     in    a    subrang^e    )    and    the     type    of  */ 

/*  subrange,    given    that    the    subrange    type    is  */ 

/*  a    named    identifier.  */ 

subrSidentSproc 5    proc; 

cons  tSpnSptr  =  cons  tSpnSptr-1 ; 

cons  tSindx=cons  tSindx-cons tSpnSs  izeC  cons tSpnSptr) ; 
pr  intname= . cons  tSva lue ( cons  tS  indx) ; 
symhash=cons  tSpnShash( cons  tSpnSptr) ; 
if    not     lookupSident    then   call    subrSerror; 
else    /*    found    constant    identifier    */ 
do; 

base= lookupSaddr; 

call    se taddrptr(4) ;    /*    points    to    form(byteptr)     */ 

subrSform=byteptr ; 

if    subrSform   <>    07h  and    (subrSform  and    formmask)    <>    consSentry 

then   call    subrSerror; 
else    do; 
if    subrSform   =    07h    then 
do  ; 

subrStype( subrSptr) =ordStype ; 
call    se taddrptr( 5) ; 

subrSform=byteptr ;    /*    length   of    p. name    */ 
call    se taddrptr( 6+subrSform) ; 
subrSval(subrSptr) =double( byteptr) ; 
call    se taddrptr( 7+subrSform) ; 
subrStypeSaddr(subrSptr) =addrptr; 
call    ordShiSlo>v«check; 
end; 
e  Ise 
do ; 

do    while    (( shr( subrSform, 3)    and    3h)=0); 
if    shr(subrSform,5) =neg    then 

if    subrSpnSs ign=pos     then   subrSpnSs ign=neg; 
else    subrSpnSs ign=pos ; 
call    se taddrptr( 5) ; 
subrSform=byteptr ; 
call    se taddrptr( 6+subrSform) ; 
if    not     looknpSonly( aptraddr)     then 
do ; 

call    subrSerror; 
subrSptr=subr$ptr+l ; 
re  turn; 
end; 
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e Ise    do  ; 

base= lookupSaddr ; 
call    se taddrptr(4) ; 
subrSform=byteptr ; 
end; 
end ; 

if    (9hr(subrSform,3)and    3h)    =    2    then 
do  ; 

call    subrSerror; 
subrSptr  =  subrSptr+l ; 
return; 
end ; 
/«    here    we    have    either    an    integer    or    char    */ 
if    (shr(subrSform,3)     and    3h)     =        1     then 
do;    /*    integer    */ 

call    se taddrptr(5) ;  " 

subrSform=byteptr ; 
call    se  taddrptr(6+sabr$forin)  ; 
if    subrSpnGsign    =    neg    then 

subrSval(subr3ptr)=       -    addrptr; 
else    subrSvaK  subrOptr)  =addrptr  ; 
subrStype(subrSptr)  =  integer© type ; 
call    subrSintShiSlov/Scheck; 
end  ; 
e  Ise 
do  ; 

call    se taddrptr( 5) ; 
subr3form=byteptr; 
call    se taddrptr( &+subrSform)  ; 
if    byteptr    <>     1     then 
do  ; 

call    subrSerror; 
subrOptr=subrSptr+l ; 
re  turn; 
end ; 
call    se taddrptr(7+subrSform) ; 
if    byteptr    <41h  or    byteptr    >    5ah    then 

call    subrSerror; 
e  Ise    do ; 

subrSvaK  subrSptr)  =doub  le(  byteptr-41h)  ; 
subrStype( subrSptr) =charStype ; 
call    ordShiSlowScheck; 
end ; 
end; 
end ; 
end; 
end; 
subrSptr=subrSptr+l ; 
end    subrSidentSproc ; 

j^^fejfc^lf  ^f  ^f  ?ifc  ^tC  iJf  ttc  ^^  ^ialC  ^tt^i^i  ^C^f^^iC^C  ^£  'it'  S^*^  ^JS^tf  ^If  ^^  ^ic  ilC  iit  ^  ^  Sf  ^Jf  S^  ^(f  ^^  St  Sf  ^if  ^^  ^  Sf  St  tit  St  St  St  / 

/*      subrangeScase    -    this    procedure     is    used    to  */ 

/*       determine     the    number    of    entries     in    a    subrange*/ 

subrScase:  proc ; 

subrSpnSs  ign=pos ; 
do    case    cons tSvec( vecptr) ; 
/*   case    const    number    */ 
do;    cons t$ptr=cons tSptr-1 ; 

if    cons tSnumStype( constSptr) =realStype    then 
do ; 

call    subrSerror; 
cons  tSindx=cons  tSlndx-bcds  ize ; 
end  ; 
e  Ise 

do;    /*    integer    type    ^/ 

cons  tSindx=cons  tSindx-2; 

cal  1    move(  .cons  tSva  lue(  cons  tSindx)  ,  .  subrSvaK  subrSptr)  ,2)  ; 

subr St ype( subrSptr)  =  integerStype ; 

call    subrSintShiSlowScheck; 


1S5 


end ; 
subrCptr  =  subrSptr+l ;     X*    next     to    fill    */ 
end ; 

/*   case     ident    constant    */ 
call    subrSidentSproc ; 
/*    case    sig^ned    ident    constant    */ 
do ; 

subrSpnSs  ign=ueg; 
call    subrSidentSproc; 
end ; 

/*    case    constant    string   */ 
do; 

cons  tSpnSptr  =  cons  tSpnSptr- 1  ; 
cons  tSindx=cons  tSindx-cons  tSJpnSs  izeCcons  tSpnSptr)  ; 
pr  intname= .cons  tSva lue( cons  tSindx)  ; 
if    cons tSpnSs izeCcons tSpnSptr)    <>    2    then 

call    subrSerror; 
e  Ise 
do; 

base=pr intname ; 

call    se taddrptr(  1)  ; 

if    byteptr    <    41h  or    byteptr    >    5ah    then 

call    subrSerror; 
e  Ise 
do; 

subrSva 1( subrSptr) =doub le( byteptr-41h) ? 
subrStype( subrSptr) =charStype ; 
call    ordShiSloy^check; 
end ; 
end ; 
subrSptr  =  subrSptr+l ; 
end  ; 
end;    /*    of    case    cons tSvec( vecptr)    */ 
end    subrScase; 

/St!  *ifjf^^*t*^f^^f*if  ^IC^k^tit  ^if  3lf  ^(rSf  ^  ^/£^ii  ^l£  Sf  St  St  Sf  Vf  ^^  ^^  ^If  3^  ^if  Sf  S?  S?  Sf  ^if  ^f  ^^  )lf  )t  St!  )ftf  ^tf  Ntf  ^^  StVf  ^^^?  / 

/*  enterSsubrangeSentry   -    this    procedure     is  */ 

/*  used    to    enter    a    subrange    type    entry    into  */ 

/*  the    symbol    table,     this    symbol    table    entry  */ 

/^  has    no    printname    asjsociated    with    it.  */ 

enterSsubrSentry:    proc ; 

typeSloc  t  =  sbtbl ; 

call     limits( 14) ; 

vecptr= vecptr— 1 ; 

call  subrScase; 

vecptr= vecptr- 1 ; 

call  subrScase; 

call  enterScomplexStype(shl(subrS<:ype  ,6)or  0fh)  ; 

call  se taddrptr( 5) ; 

if  subrStype= integerStype  then 
addrptr= . ini tSsymbStb 1 ; 

if  subrStype=charStype  then  addrptr=( . ini tSsymbStb 1+23) ; 

if  subr6type=ordStype  then  addrptr=subrStype$addr ; 

call  se taddrptr(  7)  ; 

addrptr=subr$va 1( 1) ; 

call  se taddrptr(9) ; 

addrptr=subrSva 1 ; 

call  se taddrptr( 1 1) ; 

if  subrStype= integerStype  then  /*  range  0  to  64k  */ 

addrptr= integerSdif f ;  /*  may  be  greater  than  32767  */ 

e  Ise 

addrptr=( ( subrSval-subrSva 1(  1)  )  +  l)  ; 

subrSptr=0; 

sbtbl=sbtbl+8; 
end    enterSsubrSentry; 

typeSerror!     proc; 
a  1  loca te= f a Ise ; 
cal  1    error(  '  it ' ) ; 
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end    typeSerror; 

/*  allocate    offset    -    this    procedure     is    called    to*/ 

/*  determine     the    number    of    bytes    required    for       s.-/ 

/>i;  storage    of    a    variable    of    the    type    given    in      */ 

/;,"«  the    parameter     'a',     the    variable's    allcSqty      %/ 

/*  and    allcGform   are    set    upon   return.                             */ 

allcSoffset:    proc(a);    /*    typeSloct    */ 
dc  1    a    addr ; 

del    (al IcOform.b)     byte ; 
base  =  a ; 

call    setaddrptrC 4) ;    /*    points    to    form  of    type    */ 
allcSform=    byteptr    and    formrnask; 

if    allcGform   <>     typeGentry  and    allcGform  <>     typedcle    then 
do; 
call    typeSerror; 
al  lcGqty=  1; 
a  1  IcGbas icGtype  =  0; 
return; 
end ; 

do    whi  le(  (shr(  byteptr  ,3)  and    f  orinmask)  =7    and    a  1  IcSf  orra=  typeSentry)  ; 
call    se taddrptr( 5) ; 
call    se taddrptr( 6+byteptr)  ; 
base=addrptr ;    call    se taddrptr( 4) ; 
a  1  IcSf orin=byteptr    and    forirmiask; 

if    allcGform   <>     typeGentry   and    allcGform   <>     typedcle     then 
do;     call     typeGerror; 
allcGqty=  1; 

a  1 IcGbas icGtype  =  0;    return; 
end  ; 
end ; 
/*   here    exists    either    a    basic    type    or    a    type    declaration   */ 
if    allcGform    =     typeGentry    then 
do;     /*    basic     t>-pe    «/ 
do    case    ( shr( byteptr , 3)    and    formmask) ; 
/*    integer    */ 
do; 

allcSqty=2; 

a  1 IcSbas  icGtype=  integerOtype ; 
end ; 

/*    bed    real    */ 
do  ; 

al  lcGqty=8; 

a  1 IcSbas  icStype  =  uns  ignSexpon; 
end ; 

/*    character    */ 
do; 

al  lcSqty=  1 ; 

a  1 IcGbas  icS type  =  charS type ; 
end ; 

/*    boolean   */ 
do; 

allcSqty=l; 

a  1 IcSbas  icStype  =  boo leanStype ; 
end ; 
end;    /*    of    case    */ 
allocates  true ; 
re  turn; 
end ; 
/*    here    exists    a    type    declaration    */ 

allc3form=(shr(byteptr,3)and    formmask) ; 
if    allcGform=0    then 
do;     /*    scalar    */ 
a  1 loca te=  true ; 

allcGqty=double(allcSform+l)  ; 
al lcSbasicGtype=ordStype;    return; 
end ; 
if    allcSform=l     then 
do ;    /*    subrange    */ 


157 


allocate=  true ; 

a  1  IcCbas  icG type  =  complexS type ; 
b=shr( byteptr , 6) ; 

if    b    =     1     then    a  1 lcSqty=doub le( a  1 IcQf orra+l)  ; 
else    a  1 lcCqty=doub le( a llcGform) ;    return; 
end ; 
if    allcSforin=2    then 
do ;     /*    array   */ 
al  locate=  true ; 

a  1  IcGbas  icGtype  =  complexStype ; 
call    se taddrptr( 8) ; 
a  1 lcGqty=addrptr ;     return; 
end ; 
b  =  2; 

/*    all    other    cases    allocate    an   address    field    */ 
al lcOqty=double(b) ; 
a  1 IcSbas  icGtype  =  complexStype  ; 
a  1  loca te=  true ; 
end    allcCoffset; 

/  5r»  5K  5fC  JR  5|t  3(C  ^  rlC  JfC  ?j*  5ft  JjC  3fC  3(C  JjC  .^ 

/*  a  1 IcGindexGof fse t    -    this    procedure     is    called  */ 

/*  to    determine     the    number    of    bytes    required  Jf/ 

/*         by  an   array    to    store    the    array's    components  */ 

/*  typeGloct     is    set    prior    to    calling^    this  */ 

/*         routine,     an   address    variable    containing    the  */ 

/%         byte    count     is    returned.  */ 

al IcSindexGof fse t :    proc    addr; 
del    a    addr.b    byte; 
a , base=  typeG loc  t ; 
call    se taddrptr( 4) ; 

do    while    ( 3hr( byteptr , 3)    and    formmask)    =    7   and 
(     byteptr    and    formmask    )     =     typeGentry; 
call    se taddrptr( 5) ; 
call    se taddrptr( 6+byteptr) ; 
base=addrpir ;     call    se taddrptr( 4) ; 
end ; 
/*    here    we    have    either    a    sea lar , subrange , boo  lean,    or    char    type    */ 
b=    shr( byteptr, 3)    and    formmask; 
if    (byteptr    and    formmask.)    =     typeGentry    then 
do; 

ifb=0orb=     1     then 
do; 

call    error( ' ia ' ) ; 
b=2; 

return    double(b); 
end  ; 
if    b=2    then   /*    character    subrange    */ 
do ; 
b    =    26; 

recSvarGtyp( recSns t) =charStype ; 
return   double(b); 
end ; 
/5ft   boolean   5P/ 

recOvarGtyp( recSns  t ) = boo  lean© type ; 
b    =    2;    return   double(b); 
end ; 
/*    complex    type    */ 

if    ((    byteptr    and    formmask)    <>     typeSdcle    or 
((     b    <>    0    )     and    (     b    <>     1    )))     then 
do; 

call    error('ia'); 
b=2;     return   double(b); 
end; 
if    b=0    then 

do;    /*    scalar    type    */ 
recSvarStypC  recSns  t) =complexStype ; 
call    se taddrptr(5) ; 
call    setaddrptr(6+byteptr) ; 
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return    doub  le(  Lyteptr   +    1); 
end ; 
/*    subrange    type    */ 

recGvar3  t  yp(  rec3ns  t )  =orclOtype  ; 
call    se taddrptr(  1 1 )  ; 
return   addrptr; 
end    a  1  IcS indexCo f f se t ; 


/*  se tSvar iab leCtype    -    this    procedure    is    called    «/ 

/s:  to    set    the    variable    type,    variable    sign, and    */ 

/'':-  address:    o:     the    basic     type    given,     the    address*/ 

/-.''  variable     '  looIiupQaddr '     is    set    prior    to    the       */ 

/*  call.                                                                                                          «/ 


se tSvarGtype J    proc ; 

varGp  tr  =  varijptr+  1 ;    base=  lookupOaddr  ; 
call    se taddrptr( 4) ; 

if    (byteptr    and    formcjask)     =    consOentry    then 
do;       /*    constant    variable    */ 
subrGpnGs isn=pos ; 

do    while    ( slii-(  byteptr ,  3)    and    03h)    =    0; 
if    (shr<byteptr,5)    and    01h)    =     1    then 
do ; 

if    subrCpnGs ign=pos    then   subrSpnGs lgn=neg; 
else    subrGpnGs ign=pos ; 
end; 
call    se taddrp tr( 5) ; 

if    not    lookupOpnGonly(aptraddr)     then 
do ; 

call    error('ic'); 
/^    put     in   default    values    to    return   with  */ 
re  turn; 
end ; 
call    se taddrptr( 4) ; 

if    (byteptr    and    fornunask)    <>    consGentry    then 
do  ; 

ca 1 1    error(  '  ic ' )  ; 

/■»    put  in  default  values  to  return  with  */ 
re  turn; 
end ; 
end ; 

/«  here  we  have  a  non-identifier  constant  variable  ^/ 
if  (shr(byteptr ,3)  and  3h)  =1  then 
do;  /*  integer  or  boolean  constant  */ 
if  base  <  1000h  then 
do;  /*  boolean  */ 
call  se taddrptr( 5) ; 
call  setaddrptrCS+byteptr)  ; 

varGbase( varSptr)=aptraddr;  varSs ignC varSptr) =pos ; 
varCtypeC varGptr) =4h; 
end  ; 
else  do;  /*  integer  constant  */ 
call  se taddrptr( 5) ; 
call  setaddrptr(6+byteptr) ; 

varSbase( varGptr)=aptraddr;  varGtype( varGptr) =5h; 
varGs  ign( varSptr) =subrSpnGs  ign; 
end ; 
re  turn; 
end; 
if  (shr(byteptr,3)  and  3h)  =  2  then 
do;  /*  real  constant  */ 
call  se taddrptr( 5) ; 
call  setaddrptr(6+byteptr> ; 

varGbase(varSptr)=aptraddr;  varStype( varSptr) =6h; 
varGa  ign( varSp tr ) =subrSpnSs  ign; 
re  turn; 
end ; 
/*  default  constant  of  string  */ 
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call    se taddrptr(5) :    call    se taddrptr( 6+byteptr) ; 
vai'Cbase(  varGptr)=aptraddr;    varOtype(  varGptr)  =7h; 
return; 
end;    /*    of    constant    variables    */ 
If    (byteptr    and    formmask)     =    varGentry    then 
do;     /*    declared    variables    */ 
ptrptr  =  shi-(  byteptr,  3)    and    formmask;    /*    type    of    var    ^S/ 
call    se taddrptr(5) ;    call    se taddrptr( 6+byteptr) ; 
varGbase( varSptr)=addrptr;    /*   relative    addr   of    var    «/ 
/*    sign    is    always     ignored    */ 
do    case    ptrptr; 
/'i«    case    0    ord    variable    */ 
do  ; 

varGtype( varGptr) = 10h; 
aptraddr=aptraddr+2; 

varGbase 1( varGptr) =addrptr;    /^  addr   of    parent    «/ 
end ; 

/*    case     1     integer    variable    */ 
varGtypeC  varGptr) =09h; 
/*    case    2    char    variable    */ 
varGtype( varGptr) =0bh; 
/*   case    3    real    variable    */ 
var G type ( varGptr) =Oah; 
/:.•    case    4    complex    variable    */ 
do;    /*    not     implimented    */ 

/■^    insert    complex  variable    routines    here    */ 
end ; 
/*    case    5    boolean    variable    */ 
varGtypeC  varGptr) =G8h; 
end;    /«    of    variable    case    */ 
re  turn; 
end ; 
if    byteptr    =    7h    then 

do;    /*    scalar    constant    */ 

call    se taddrptr(  5) ;    call    se taddrptr( 6+byteptr) ; 
varSbase(varGptr)=aptraddr;    aptraddr=aptraddr+l; 
varGbase  1(  varCp  tr)  =addi*ptr;    /*    parent    type    of    scalar    */ 
var G type ( varGptr) = 1 Ih; 
re  turn; 
end ; 

end    se tGvarStype ; 

/^**;f::i:*****»**:iC5!C**;ft****5f:**5f:*5<t***5fS5K?iS5f:5it5i«p  Jiff's  :!!**^5!c:j::{;:!C5Sc/ 
/*  loadCvar iab le  —  this  procedure  generates  the  */ 
/5#s  intermediate    code    to     load    the    next    variable    */ 

/*         on    the    execution   stack   of    the    object    file         */ 


loadSvar iab le :    proc ; 

if    varGtype( varGptr)    <    08h    then 
do;    /*    constant    variable    */ 
aptraddr  =  varSbase(  varGptr)  ; 
if    varOtype( varGptr) =04h    then 
do;    /*    boolean   constant    */ 
call    generateC  Idi i)  ;    call    genera te( byteptr) ; 
call    genera te(nop) ;    /*    high  byte    zero    «/ 
expGtype( expGptr) =boo leanGtype ; 
end ; 
if    varGtypeC varGptr )=05h    then 
do;    /*    integer    constant    */ 
call    genera te(  Id i i)  ;    call    genera te( byteptr) ; 
call    genera te( high( addrptr)  )  ; 
if    varCs ign( varGptr) =neg    then 
call    genera te(negi); 
expGtypeC  expGptr)  =  integerStype ; 
end ; 
if    varGtype( varGptr) =06h    then 
do;    /*    bed    constant    */ 
call    genera te(  Idib)  ; 
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do    ptrptr=l     to    (bcdsize/2); 

call    generateCbyteptr);    call    genera te ( hi^M addrptr) ) ; 

aptraddr=aptraddr+2; 
end ; 

if    varCsiffn( var&ptr)=neg    then 

call    genera  te( negb)  ; 
espOtypeCespSptr) =uns  ignSexpon; 
end;    /^    of     load    bed    */ 
if    varCtype( varCptr)=07h    then 
do;    /«    string    constant    */ 
call    2renerate(nop)  ;    /*   not    implimented    «/ 
expGtype(expOptr)=3tring3type; 
end  ; 
varGptr  =  varGptr- 1 ; 
re  turn; 
end;    /*    of    constant    variable    load    */        * 
if    varStype( varOptr)    <     1 Ih    then 
do;    /*    simple    variables    */ 
call    seaerate(  1  i  ta)  ;    /^'^    load    addr    of    variable    «/ 
call    genera te( low( varSbase( varGptr) ) )  ; 
call    generate( high( varCbaseC varGptr) >)  ; 
if    varGtype( varGptr) =    08h    then 
do;     /*    boolean    variable    */ 
call    genera te(  lod)  ; 
espGtype(expGptr) =boo leanStype; 
end ; 
if    varG type ( varGptr) =09h    then 
do;     /*     integer    variable    il^/ 
call    genera te( lod i ) ; 
expCtype(expGptr) =  iategerGtype ; 
end ; 
if    varGtype( varGptr) =    Oah    then 
do;    /*    real    variable    */ 
call    genera te(  lodb)  ; 
expOtype( expGptr) =uns  ignGexpon; 
end ; 
if    varGtype( varGptr) =    Obh    then 
do;    /*    char    variable    */ 
call    genera te( lod) ; 
exp3type( expGp tr) =charStype ; 
end ; 
if    varGtype( varGptr>=     lOh    then 
do;    /*    ord    variable    */ 
call    generate(lod); 
expStype( expGptr) =ordStype ; 

expGtypeGaddr(  expGptr)  =  varSbaseK  varGptr)  ; 
end ; 
varGptr= varGptr- 1 ; 
re  turn; 
end ; 

if    varGtypeC varSptr)=     llh    then 
do;    /-^    ord    constant    */ 
aptraddr  =  varGbase( varGptr )  ; 
call    genera te( Id i i ) ; 

call    genera te< byteptr) ;    call    genera te( nop) ; 
expGtype( ezpSptr) =    ordGtype; 

expGtypeGaddr( expGptr) =    varSbase 1( varGptr) ; 
varSptr= varGptr— 1 ; 
end ; 
end    loadGvar lab le ; 

/«:::::::::::::::::::::::::::::::::::*/ 
/*  this  procedujre  checks  the  top  two  */ 
/*  variables  on  the  execution  stack  */ 
/*    for    proper    type.  */ 

checkGexprsG type  5    proc    byte; 

if    (  expGtype(expGptr) =ezpGtype(expSptr-l) )    and    expStype( expGptr) <>0h 

then    return    true; 
if    expGtypeC expGptr) = Ih    then 
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do  ; 

if    espStype(e2pQptr-l)=3h    then 
do  ; 

call    seaerate(cnvi) ;    /*   convert     int    to    bed    */ 
expCtype(expGptr) =3h; 
return    true; 
end ; 
else    return    false; 
end; 
if    expStype( expOptr) =3h    then 
do  ; 
if    eirp3type(exp0ptr-l)  =  Ih    then 
do  ; 

call    genera te(cn2i) ;    /«   convert    second    int    to    bed    */ 
espCtypeC  expSptr- 1) =3h; 
return    true; 
end ; 
else    return    false; 
«nd ; 
if    expo  type ( expOptr) =0h    then 
do  ; 

if    espGtype( espSptr- 1) <>0h    then 

re  turn    f a  Ise ; 
e  Ise 
do; 
if    expStype£Jaddr(expSptr)=expStypeOaddr(expSptr-l)     then 
return    true; 
end ; 
end ; 

return    false; 
end    checkSexprsOtype ; 


/«      V.T  i  teCs  tr  ing   -    this    procedure    writes    */ 
/*         a    string:    to     the     in  termed,    code  */ 

wr i teSs tr ing!     proc; 

dc 1  n  based  printname  byte; 

call  se t lookup(  sp)  ; 

call  genera te( wrvs) ; 

call  generate(n); 

do    ptrptr    =     1     to    n; 
call    genera te( n( ptrptr)  )  ; 

end ; 
end    wr i teSs tr ing; 


/*  wr  i  teGvai' lab  le  -  this  procedure  will  */ 
/*  write  a  variable  to  the  console  via  «/ 
/%         the     intermed.     code.  */ 


iteSvar 

:     proc ; 

if    expS 

ptr    =     11     then 

do ; 

ca 

1 1    errorC ' es ' ) ; 

ca 

11    mo  n3 ; 

end; 

expSptr 

=expSptr+l; 

call     loadSvar iable ; 

do    case 

expStype(expSptr) ; 

call 

genera  te( wrvi ) 

call 

genera  te(wrvi) 

call 

genera  t e ( wrvi ) 

call 

ge  ne  ra  te  (  wr vb ) 

call 

genera  te( wrvi) 

call 

genera te ( wrvi ) ; 

end ;    /* 

of    expStype    cs 

ise    */ 
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exp3ptr=expCptr-l ; 
e  nd    wr  i  t  e  Ova  r ; 

/*      readGvariable    -    th.is    procedure  generates    */ 

/«         the    intermediate    code    to    read  a    variable*/ 

/^         from    tlie    console.  ^/ 

/  ::wK  ;;::•;:;;  .-i-.  ;•;«  ^c  *  :tc «« ,-i;  «;,<;  :ic -c  -  >;o;;  ;;;;■:;,>;;«  :;o.<c  ^;  ;;::#;*  ^i;  ,^ 

readCvar:    proc ; 

if    varGtype( varGptr)     <     OGh    then 

ca 1 1    error ( ' ir ' ) ; 
e Ise    do  ; 

if    varCtype( varOptr)    <     llh    then 
do; 

if    varOtype( varSptr)=08h    then 
do;    /*    read    boolean   not     implimented    */ 
end  ; 

if    varOtype( varGptr) =09h    then 
do  ; 

call  genera te( rdvi)  ; 

call  generate(  s tdi)  ; 

call  generate(low( varGbase(  varSptr)  )  )  ; 

cal 1  generate(high( varObaseC varCptr) ) )  ; 
end  ; 

if    varGtype( varSptr) =0ah    then 
do;    /*    real    */ 
call    genera te(  rdvb)  ; 
call    genera te(  s tdb)  ; 

cal 1    generate( lowC  varSbaseC  varSptr) ) )  ; 
call    generateC  high( varSbase(  varSptr) ) )  ; 
end ; 
if    varStype(  varSptr) =0bh    then 
do;    /:.-    read    char    not     implimented    */ 
end ; 
if    varStype( varSptr) = lOh    then 
do;    /:S    read    ord    not     implimented    */ 
end ; 
end ; 

if    varCtype( varGptr) = 1 Ih    then 
call    error('ir'); 
vari5ptr  =  varGptr- 1 ; 
end ; 
end    readSvar; 


if    lis  tprod    then 
call    printGprod; 


do    case    production; 


/«5ic  :«***;}:  :f::^**;f{********«*************«:!{***********5!«:fc:fC5S*:S*«******5f{:S**>K*>K 

/***  produc    t     ions  ***/ 

/:ic********5|t**********:(J****************************************5f:S«**»**:^ 

/**«  the    following    is    the    input    grammar  *«*/ 

/*  case    ©not    used  */      ; 

/*  1  <program>     '•'•=    <program  heading>    <block>     .    _l_  */ 

do  ; 

call  printSerror; 

call  printcharC'     '); 
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call    cr If  ; 

call    priut(.'     compilation    comple te . 0' ) ; 
ca  1 1    cr  If ; 

if    not    (errorcount    >    0)     then 
do; 

call    genera te( a  1 1)  ; 
call    genera te (  low( a  1 locSaddr) ) ; 
call    genera  te  (  higli(  a  1  locCaddr)  )  ; 
call    genera te( endp) ; 
end ; 
call    ^vriteSintGf lie; 
call    c loseQ intOf i le ; 
call    mo  n3 ; 
end; 

<prograni  heading>     ::=    program  <prog    ident>    (  */ 

<file     ident>    )     ;  */ 


/■» 

2 

/« 

2 

/^ 

3 

/« 

3 

I    program   <prog    ident)     (  */ 

<file     ident>     ,    <file     ident>    )     ;  */ 

/5fc  4         <prog    ident>     ::=    <  identifier)  */ 

9 

/:;:  5         <flle     ident>     ::=    <identifier>  */ 

if    firstGtime    then 
do; 

firstStime    =    false; 

call    enterSvarSid( 0, sp, f i le Sentry)  ; 
end  ; 
e  Ise 

cal 1    enterGvarSidC 16, sp, file Gentry); 

/*  6         <block>     ::=    <  ldp>    <cdp>    < tdp>    <vdp>    <pafdp>    <stmtp>  «/ 


/5i!  7        <  ldp>    ::  = 


/* 


/^a  11         <label>     •'•=    <number> 

if    typenum   <>     integerStype    then 
call    error(  '  Is ' )  ; 


/«  16         <ident    const    def>     ::=    < ident    const>    =    <constant> 

call    enterGconstSentry; 
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*/ 


8  I  label  <  label  string>  ;  */ 


*/ 


/*  9         <  label    string>     ::=    <label> 

if    typenum   =     integerStype    then 
do  ; 

call    enterSvarSid(0,sp, lablSentry)  ; 
call    enterSlabel; 
end ;  ^  . 

/->  10  I    <  label    string>     ,    <Iabel>  */ 

if    typenum   =     integerStype    then 
do  ; 

call    enterOvarSid(0,sp, lablSentry) ; 
call    enterOlabel; 
end ; 


*/ 


*/ 


/«  12         <cdp>     : := 

/:{•       '        13  I    const    <const    def>     ;  * 


*/ 


/:(:  14         <const    def>     ::=    <  ident    const    def> 

/^.      '       j5  I    <const    def>     ;    <  ident    const    def>  */ 


*/ 


/«  17         < ident    const>     ::=    < ident if ier>  #/ 

do; 

if    looknpGonlyC sp)     then 

call    error('dc'); 
call    enterCvarOidC  0 , sp, cons Sen try) ; 
end ; 

/^  18         <constant>     ::=    <number>  */ 

do; 
call    CO  nvr  tGconst(pos) ; 
cons  tCvec  (  vecp  tr)  =coiisOnumOtype  ; 
vecptr=vecptr+l ; 
end  ; 
/*  19  I    <sign>    <number>  */ 

do; 
if    siffntype=nes    then 

call    convr tOcons t ( neg)  ; 
else    call    convi*  tGcons  t  (  pos  )  ; 
cons  tGvec( vecptr) =consGnumGtype ; 
vecp t r= vecp tr+ 1 ; 
end ; 
/^  20  I    <constant    ident>  */ 

do  ; 
cons iGvecC  vecptr) =consOidentStype ; 
vecptr=vecptr+l; 
call    s toreGcons tG ident ; 
end  ; 
/*  21  i    <siffn>    <constant     ident>  */ 

do  ; 
if    s  i;jntype  =  nes    then 

cons  tGvec ( vecp tr) =consGs  ident Q type ; 
e Isc    cons  tCvec (vecptr) = cons© identS type; 
ve  cptr  =  vecptr+l ; 
call    s toreGcons tGident ; 
end ; 
/*  22  I    <strins>  */ 

do; 

cons  tSvec( vecptr) =consGs  trGtype ; 
vecp tr= vecp tr+ 1 ; 
call    s toreGcons tGident ; 
end; 

/*  23         <constant    ident>     ::=    <identifier>  *^ 

f 

/%  24         <  s  i  gn>     :  :  =    +  */ 

s  i  ffn  t  ype  =  po  s  ; 
/*  25  I    - 

s  i  ffn  t  ype  =  ne  g ; 


/^ 


/% 


/% 


/* 


*/ 


/*  26         < tdp>     ::=  *^ 

caseSs  tmt=false; 

27  I     type    < type    def    strinff>     ;  */ 


caseSs  tnit=false; 
/*  28        <  type    def    strins>     ::=    <  type    id>  *>' 

29  I    < type    def    string>     ;    < type    Id>  */ 


30  <  type    id>     :  :  =    <  type    ids>    =    <  type>  *'' 
do; 

aptraddr=  typeSaddr; 
addrptr=  typeSloc t ; 
end; 

31  < type    ids>     ::=    <identifier>  *^ 
do; 

if    lookupGonly(sp)     then 

call    error( ' d t ' ) ; 
parents type  =  sb  tb 1 ; 
call    enterSvarGid(78h,sp, typeSentry) ; 
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call     liinits(2); 
typeGaddr=sb tb 1 ; 
sbtbl=sbtbl+2; 
end ; 


/« 

32 

/* 

33 

/* 

34 

/iti 

35 

/* 

36 

1 

37 

<  type>     ::=    <slmple    type>  :H/ 

I    < structured    type>  */ 

I    < pointer    type>  */ 

<simple    type>     ::=    <scalar    type>  #/ 

I    < subrange    type>  */ 

I    <  type    ident>  */ 


/*  33        < type    ident>     ::=    <identifier> 

if    Iools.up3pn0id(  sp,  typeOentry)     then 

typeOloc  t= lookupSaddr ; 
e  Ise 
do  ; 

call    error(  '  t  i ' )  ; 
typeGloc t=  .  ini  tSsymbStbl ;       /*    integer    default    */ 
end ; 


/* 


*/ 


39         <scalar    type>     ::=    (    <tident    strlns>    )  */ 


y^  4©         <tident    string>     ::=    <identifier>  */ 

do; 

t ypeSo r dSnuni=  0  5 

typeGloc t=sbtbl; 
if       lookupConlyC sp)     then 
ca  1  1    error(  ' d  t ' )  ; 

call    enterGvarCid(0,sp, typeSdc le) ; 

call     1 imi ts(3) ; 

aptraddr=sbtbl; 

byteptr  =  G ; 

aptraddr=aptraddr+l; 

addrptr  =  parents  type ; 

sbtbl=sbtbl+3; 
end ; 
/*  41  t    <tident    strinff>     ,    < identif ier>  */ 

do; 

typeSordOnum=  typeOordSnum+ 1 ; 

typeGloc t  =  sbtbl  ; 

if       look.upOonly(  sp)     then 
ca  1  1    error (  ' d  t ' )  ; 

call    enterSvarOid( 0,sp, typeSdc le)  ; 

ca 11     limits(3); 

aptraddr=sbtbl; 

byteptr=  typeSordSnura; 

aptraddr=aptraddr+l; 

addrptr= parents type ; 

sbtbi=sbtbl+3; 
end; 

/«  42         <  subrange    type>     ••  :  =    <constant>    ..    <constant>  */ 

call    enterSsubrSentry; 

/*  43         < structured    type>     ::=    < unpacked    structured    type>  */ 

/*  44  I    packed  */ 

/«  44  < unpacked    structured    type>  */ 

/*  45         <unpacked    structured    type>     ::=    <array    type>  */ 

/Ttt  46  '    <  record    type>  */" 
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47 
48 


I  <set  type>  */ 

I  <  f i  le  type>  %/ 


/«      49    < array  type>  ::=  array  < lp>  < index  type  strine>  < rp>      */ 
^^   .   *^  of  < component  type>  %/ 

do  ; 

if  arrySptr  =  -1  then  arrySptr=0; 
call  enterCcomplexGtype( 17h) ; 

arySdniGadrCptr  =  arySdniOadrSptr-numSarrySdimen(  arrySptr)  : 
arrySbase  =  base  ; 

cal 1  1 imi ts( ( numSarrySd imen( arrySptr) *2) +3) ; 

call  se taddrptr(  5) ; 

byteptr  =  nuuiOarrySd  imen(  arrySptr)  ; 

call  se taddrp tr( 6) ; 

addrSptr=  type Sloe  t ; 

call  ai  IcOof  fset(  typeSloct)  ; 

base=arryGbase ; 

call  se taddrp tr( 8) ; 

addrptr=arry6qty( arrySptr) *al IcSqty; 

call  se taddrptr( 10) ; 

byteptr  =  a 1 IcObas  icGtype ; 

do  subrSform=0  to  ( numSarrySd imen( arrySptr) - 1 ) ; 

call  se taddrptrC 1 l+( 2*subrSform) ) ;  , 

addrptr  =  arryddiiiien(arySdmSadrSptr+subrforin+l)  ; 

end; 

typeSloc  t  =  base  ; 

sbtbl=sbtbl+(( nmnOarrySdimen( arrySp tr ) *2) +6) ; 
arryOp tr=arrySptr— 1 ; 
end ; 

/*  50         <lp>     ::=    (*  Hi/ 

/*  51         <rp>     : :=    *)  */ 

/"-  52         <  index    type    string>     ::=    <  index    type>  */ 

do; 
if    arry€>ptr  =  arrySnes  t-1    then 
do; 

call    error('an'); 

arySdinCadrGptr  =  arySdraSadrSptr-numSarrySdinien(  arrySptr)  ; 
end ; 
else    arrySptr=    arrySp>-tr+l; 
arryCd  imSptr  =  0; 

arySdmGadrSptr  =  arySdmSadrSptr+l ; 
arryGd  inien(arySdmSadr$ptr)  =  typeSloc  t ; 
arryCqty( arrySptr) =al IcSindexSof f se t ; 
numSarrySd  imen( arrySptr)  =  1 ; 
end ; 
/*  53  I    < index    type    strinff>     ,  */ 

/5S  53  <  index    type>  */ 

do ; 
if    arrySd  imGptr  =  maxSnninSarrySd  iraen- 1    then 

call    error('ad'); 
else  arrySd imSptr=arrySd imSptr+ 1 ; 

arySdmSadrGptr=arySdmSadrSptr+l ; 
arrySdimen( arySdmSadrSptr)  =  typeSloc t ; 

arrySqty( arrySptr) =arryCqty( arrySptr )*a 1 IcSindexSof f set ; 
numSarrySd i me n( arrySptr) =numSarrySd  imeu( arrySptr )  +  1 ; 
end ; 

/«  54         < index    type>     ::=    <simple    type>  */ 

5 

/*  55         < component    type>     ::=    < type>  */ 

/v-  56         <record    type>     ::=    record    <  fie  Id    list>    end  */ 
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do ; 

var  iantOpar t ( recSns  t ) =  fa Ise ; 

base , typeSloc  t  =  recSparSadr(recSns  t)  ; 

if    varGcasSval(recGnst)     <>    0    then 

call    error( ' iv* ) ; 
call    se taddrptr( 3) ; 
a<Idrptr=fxdGofs  tSbse(recSnst)-l  ; 
call    se taddrptr( 7) ; 
addrptr=    prvSsb tb ISentry; 
recSns  t  =  recSns  t-1 ; 
end; 

/«  57         <field    list>     ::=    <fixed    part>  %/ 

^*  5S  I    < fixed    part>     ;    < variant    part>  */ 

/*  5^  I    <  variant    part>  %/ 

/*  60         < fixed    part>     ::=    <recopd    sec t ion>  */ 

/*  61  I    < fixed    part>     ;    <record    section>  */ 

/*  62         <record    section>     ::=    <field    ident    stping>     :    < type>  */ 

do  ; 
call    al IcSof fset( typeSloct) ; 

/^    a  1 IcSbas icStype    and    allcSqty  are    set    */ 
do    ptrptr    =    0    to    recordSptr; 
base    =    recSaddr( ptrptr) ; 
call    se taddrp tr ( 5) ; 
call    se taddrptr( 8+byteptr) ; 
addrptr=a 1 IcSqty; 
aptraddr=aptraddr+2; 
addrptr=  typeSloc  t ; 
aptraddr=aptraddr+2; 
addrptr=curSofs t ( recSns t ) ; 
cur Oofs  t ( recSns  t ) =curSofs t( recSns t) 
+    aUcSqty; 
end ; 

recordSptr=0? 

if    fxdCofstSbse( recSns t)    <    curSofs t( recSns t) 
then    fxdSofstSbse (recSns t)=curSofst( recSns t) ; 
end; 
/*  63  I  */ 

9 

/*  64        <field    ident    string>     ::=    <field    ident>  */ 

/*  65  I    <field    ident    stringr>     ,  */ 

/*  65  < fie  Id    ident>  */ 

/«  66         < field    ident>     ::=    <identifier>  */ 

do; 
if    recordSptr    <>    5    then   recordSptr=recordSptr+l ; 
else    call    error('rn'); 
recSaddr( recordSptr) =sbtbl ; 
cal 1    enterSvarSid(58h,sp, typeSdc le) ; 
call     limits(8); 
aptraddr=sbtbl; 
addrptr=recSparSadr( recSns t) ; 
sbtbl=sbtbl+8; 

if    var iantSpart( recSns t)     then 
do; 
base=recSaddr( recordSptr) ; 
call     liinits(2); 
call    se taddrptr( 4) ; 
byteptr=0dfh; 
end ; 
end ; 
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/« 

67 

/* 

67 

/* 

68 

/* 

68 

/>f; 

69 

/* 

70 

<variant    part>     ::=    case    <  tag    field>    <  type  ideiit>    of                 */ 

<  variant    string>  -j^/ 

I    case    < type     ldent>    of  %/ 

< variant    string>  %/ 


<variant    strinw>     ::=    <variant> 


*/ 


I     <variant    strine>     !    <variant>  «/ 


/^  71         <tag    field>     ::=    <field    ident>     : 

tasSfd<  recSns t)  =  true ; 

/*  72         <variant>     ::=    <case    label    Hst>     :     (    <field    list>    ) 

/*  73  I 

/*  74         <case    label    list>     ::=    <case     label> 


/*  75 


1     <case     label     list>     ,     <case     label>  %/ 


/•^  76         <case    label>     ::=    <constant>  */ 

if    caseSstmt    then 
do; 

/*    insert    case    stmt    routines    */ 
end ; 
e  Ise 
do  ; 
if    not    var iantSpar t( recSnst)     then 
do: 
var iantSpar t( recSnst)=true; 
varScas3tp(recSns t )  =  type Sloe  t ; 
varScasSva  KrecSns  t)=a  1  IcSindexSof  f  se  t ; 
call    aUcSof  fse  t(  typeSloct)  ; 
if     tagSfdCrecSnst)     then 
do; 

tasSfd(recSns t) =false ; 
base=recSaddr( recordSptr) ; 
call    se taddrptr( 4) ; 
byteptr=9fh; 
call    se taddrptr( 5) ; 
call    se taddrptr( 8+byteptr) ; 
addrptr=var©casSval( recSns t) ; 
aptraddr=aptraddr+2; 
addrptr=var3cas$tp( recSns t ) ; 
aptraddr=aptraddr+2; 
addrptr=curSofs t (recSns t) ; 
curSofs t( recSns t) =curSofs t( recSns t)+allcSqty; 

end  ; 
varGofs  tSbse( recSns  t) =curSofs  t( recSns  t ) ; 
fxdSofs  tSbse( recSns  t) =curSofs  t ( recSns t) ; 
end ; 
/%   call    compareScons tSvar iant ;    */ 
/5S    the    routine    above    checks     the    case     lable    with    the    variant     type    */ 

curSofs t( recSns t) =varSofs  tSbse( recSns t) ; 
vecptr= vecptr-l ; 

cons  tSptr , cons  tSindx, cons tSpnSptr  =  0; 
end  ; 

/*  77         <set    type>     : : =    set    of    < base    type>  %/ 

call    enterSstruc tStype(27h) ; 

/%  73         <base     type>     '•'--    <  simple    type>  */ 

! 

/*  79         <file    type>     ::=    file    of    < type>  */ 

call    enterSs true tStype(2fh) ; 
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/:S  80         <po  inter    type>     ::=    S    <  type     ident>  */ 

call    enterOs true tS type (37h)  ; 

/^  81         <vdp>     ::=  :({/ 

i 
/'^  82  I    var    <  var    declar    striner>     ;  */ 

/*  83         <var    declar    string>     ::=    < var    dec lar>  */ 

/*  84  I    <var    declar    string)     ;  */ 

/*  84  <var    dec  lar>  */ 

/*  85      ,<var    dec  lar>     ::=    <  Ident    var    string>     :     <  type>  */ 

do  ; 
call    al  IcSof fset( typeSloc t)  ; 
if    not    allocate     then 
do; 
allcSqty=l; 
a  1 IcSbas  icStype  =  0; 
end; 
do    ^^rhi  le    varSptr    <>     -1; 
base=varSbase(varSptr) ; 
call    sc taddrptr( 4) ; 

byteptr  =  shl( a  1 IcSbas icStype , 3)    or    varSentry; 
aptraddr  =  varSbase 1 ( varSptr)  ; 
addrptr  =  a 1  locSaddr ; 
a  1  locSaddr  =  a  1  locSaddr+a  1  IciSqty; 
aptraddr=aptraddr+2; 
addrptr=  typeSloc  t ; 
varSptr=varSp tr-1 ; 
end ; 
end; 

/^  86  < ident    var    string>     ::=    < ident if ier>  */ 

do; 

varOptr=0; 

varQbase=sb tb 1 ; 

call    enterSvarSid(0,sp, varSentry)  ; 

call     1 imi  ts(  4)  ; 

var ©base l  =  sb  tb  1 ; 

sbtbl=sbtbl+4; 
end  ; 
/*  87  I    < ident    var   string)     ,  */ 

/^  87  < identifier)  */ 

do; 

if    varSptr    <>     10    then 

do; 

varSptr  =  varSptr+ 1  ; 

varGbase( varSptr) =sb tbl ; 

call  enterSvarSid(0,sp, varSentry) ; 

call  limits(4); 

varSbase 1( varSptr) =sbtbl ; 

sbtbl=sbtbl+4; 
end  ; 

else    call    error('vn'); 

end ; 


/* 

88 

/« 

89 

/* 

90 

/« 

91 

<p8fdp>     ••= 


90         <porf    declar)     ::=    <proc    or    fnnct)     ; 


/« 


*/ 


I    <porf    declar)  *^ 


*/ 


I  <porf  declar)  <proc  or  funct)  ;         */ 

92    <proc  or  funct)  ::=  <procedure  declaration)  */ 

/:(;  '    93  I  <  funct  ion  declar)  */ 
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/»      94    < procedure  dec larat ion>  ::=  < procedure  heading>  */ 


/^  94 


<block>  */ 


/*  95    < procedure  headins>  '•=    <proc  id>  ; 

* 

/*  9^  I  <proc  id>  ( 

/*  96 


/.'i'  97         <proc     id>     ::=    procedure    <identifier> 


/* 

99 

/« 

99 

/« 

100 

/^ 

101 

/* 

102 

/* 

103 

/* 

104 

/* 

105 

*/ 


*/ 


< formal  para  sect  list>  )  ;        */ 


*/ 


/*      98    < formal  para  sect  list>  ::=  < formal  para  sect>  */ 

I  < formal  para  sect  list>  ;     */ 

< formal  para  sect>  */ 

< forma  I  para  sect>  5t=  < para  group>  */ 

I  var  <para  group>  */ 

I  function  <para  group>  */ 

I  procedure  <proc  ident  list>  */ 

<proc  ident  list>  ::=  <identifier>  */ 

I  <proc  ident  list>  ,  <identifier>    */ 

t 

/^'  106    <  para  group>  ::=  <para  ident  li9t>  :  <  type  ident>  */ 

/*     107    <para  ident  list>  ::=  <Identifier>  */ 
/*     108                          I  <para  ident  list>  ,  < identifier)    */ 

/«     109    <  function  dec  lar>  ::=  <  function  heading)  <  block.)  */ 
5 

/«     no    <  function  heading)  ::=  <  f  unc  t  id)  :  <  result  type)  ;  */ 

/*  '   111  I  <funct  id)  (  */ 

/*     111  < formal  para  sect  list)  )  :  */ 

/*     111  < result  type)  ;  */ 

f 

/*  112         <funct    id)     ::=    function   < identifier)  */ 

; 

/*  113         < result    type)     :t=    < type    ident)  */ 

5 

/*  114         <stmtp)     ::=    <compound    stmt)  */ 

5 

/*  115         <stmt)     ::=    <bal    stmt)  */ 

/*    '        116  I     <unbal    stmt)  */ 

/«    '        117  I    <  label    def)    <stmt>  */ 

/*  118         <bal    stmt)     ::=    < if    clause)    < true    part)    else    < ba 1    stmt)         «/ 

do; 
call    genera te( lb  1) ; 
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call    genera  te(  lovK  if  SlbK  ifSptr)  +  l))  ; 
cal  1    genera  te(hish(  ifSlbK  ifSptr)  +  l)  )  • 
ifOptr=ifOptr-l; 
end ; 

^*  11^  I    <simple    stmt>  ^/ 

/*  120         <unl)al    stmt>     ::=    <if   clause>    <stint>  */ 

do  ; 
call    generate(lbl); 

cal  1    genera te(  low(  if Sib 1( ifSptr)  )  )  ; 
call    genera  te(high(  IfQlbK  IfSptr)  )  )  ; 
ifGptr=  ifSptr-1  ; 
end ; 
''*  ^21  I    <if   clanse>    <  true    part>    else  */ 

/*  121  <nnbal    strat>  m/ 

do  ; 
call    generate(lbl); 

cal  1    genera  te{  low(  if  Sib  1(  ifSptr) +  1)  )  ; 
cal  1    genera  te(high(  ifOlbK  ifSptr)  +  l)  )  ; 
ifSptr=  ifSptr-1 ; 
end ; 

/*  122         <if    clause>     ::=    <if>    <  express  ion>    then  */ 

do  ; 

if    expStype(expSptr) =boo leanStype    then 
do  ; 

expSptr  =  expSptr-l ; 
call    genera te(  no tx)  ; 
call    genera te(  b Ic) ; 

call    genera  te(  low(  ifSlbK  ifSptr)  )  )  ; 
call    genera te(high(  ifSlbK  ifSptr) ) )  ; 
end; 
else    call    error('ce'); 
end ; 

/«  123         <if>     ::=     if  */ 

do; 

if    ifSptr=9    then 
do  ; 
ca  1  1    error(  '  io ' )  ; 
call    mo  n3 ; 
end ; 
ifSptr=  ifSptr+1; 
ifSlbK  ifSptr)  =  lablcount; 
lablcount= lablcount=2; 
end ; 

/*  124         < true    part>     ::=    <bal    stmt>  */ 

do; 

call    genera te( br 1 ) ; 

call    genera  te(  low(  ifSlbK  ifSptr)  +  l)  )  ; 

call    genera  te(high(  ifSlbK  ifSptr) +  1)  )  ; 

call    genera te(  lb  1) ; 

cal  1    genera  te(  low(  ifSlbK  ifSptr)  ))  ; 

call    genera te(high(  ifSlbK  ifSptr)))  ; 
end; 

/fi  125         <  label    def>     ::=    <label>     :  */ 

if     lookupSpnSiddnp,  lab  ISentry)     then 
da; 
call    se taddrptr( 5) ; 
call    se taddrptr( 6+byteptr) ; 
call    genera te(  lb  1) ; 
call    genera  te  (  low(  addrptr)  )  ; 
call    genera te( high( addrptr) ) ; 
end ; 
else    call    error('ul'); 

/%  126         <simple    stint>     ::=    <assignment    stint>  */ 

/*  127  I    <  procedure    stint>  */ 
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/* 

128 

/* 

129 

/5K 

130 

/* 

131 

/* 

132 

/* 

133 

/* 

134 

/* 

135 

<repetitive    stint> 

<case    stmt> 

<with   stnit> 

<read    stmt> 

<  wri  te    s  tmt> 

<goto    stiiit> 

< compound    stmt> 


/«  136         <as9lgnment    stmt>     ::=    <variable>     :=    <expression> 

do ; 
call    genera te( 1 i ta) ; 

call    genera te( low( varSbase( varSptr) ) ) ; 
call    generate( high( varSbase( varSptr ) ) ) ; 
do    case    ezpStype( expSptr) ; 
/*    case    0    -    ord    type    */ 

If    varStype( varSptr)<>     llh   or    expStypeSaddr(  expSptr ) <> 
varSbase 1( varSptr)     then 
goto    errorSloop; 
else    call    genera te( s td) ; 
/*    case     1    -    integer    type    */ 
if    varStype( varSptr) =09h    then 

call    genera te(s tdi) ; 
e  Ise    do ; 

if    varStype( varSptr) =0ah    then 
do  ; 
call    generate( cna i) ; 
call    genera te( s tdb) ; 
end; 
else    goto    errorSloop; 
end; 
/*    case    2    -    charStype    */ 
if    varStype( varSptr) =0bh    then 

call    genera te( s td) ; 
else    goto    errorSloop; 
/*    case    3    -    real     type    */ 
if    varS type ( varSptr ) =0ah    then 

call    genera te( s tdb) ; 
else    goto    errorSloop; 
/*    case    4    -    string    type    */ 
;     /%    not     implimented    */ 
/*    case    5    -    boolean    type    */ 
if    varStype( varSptr) =08h    then 

call    genera te( s td) ; 
else    goto    errorSloop; 
end;     /*    o f    case    */ 
go  to    s e c o nd Sloop; 

errorSloop*.    call    error('at'); 
secondSloop J 

expSptr=expSptr-l ; 
var$ptr= varSptr- I ; 
end ; 


%/ 
*/ 
*/ 
%/ 
*/ 


/* 
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<  var  iab  le> 


/* 

138 

/* 

139 

/* 

140 

/« 
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=  <entire    varlable> 

I  <variable>    S 

I  <variable>    < lp>    <expres    list>    < rp> 

I  <variable>     .     <  field    ident> 


< entire    variable>     ::=    < variable    ident> 


*/ 
*/ 
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<  identif ier> 


/*  142         < variable     ident>     :: 

if    not     lookupSoiily(  sp)     then 

call    error( 'd t ' ) ; 
else    do; 

call    setSvarStype;    /*    lookupSaddr    set    here    */ 
end ; 

/*  143         <expres    list>     ::=    <expression> 

^*  .  1'*^  I    <expres     list>     ,    <expression> 


*/ 


*/ 


143         <expresslon>     ::=    <simple    express ion> 


<siinple    express  ion> 
<relational    operator> 
< simple    express ion> 


146  I 

146 

146 
do; 

opOptr=opSptr-l ; 
if    checkSexprsStype    then 
do; 

if    <expStype(expGptr)<>4h)or(exp3type(expSptr)<>3h) then 
do    case    ( opStype( opSptr)-8h) ; 
/*    case    0    -    *    */ 
call    genera te( eql i) 
call    genera te( neqi) 
call    genera te ( leqi ) 
call    genera te( geqi) 
call    genera te( Iss i ) 
call    genera te( grt i ) 
;    /*    "in"    not     imp  1 imented    */ 
end;    /*    of    case    for    integers    */ 
if    expStype(expSptr)=3h    then 
do    case    ( opStype( opSp tr ) -8h) ; 
call    generate(  eqlb) 
call    genera  te(  neqb) 
call    genera  te  (  leqb) 
call    genera  te(  geqb) 
call    genera te( Issb) 
call    genera te( gr tb) 
;    /*    "in"    not     imp  1 imented    */ 
end;     /*    of    case    for    reals    */ 
if    expStype( expSptr) =4h    then 
do;     /«    tests    for    strings    not 
end  ; 
expStype( expSptr) =boo leanStype ; 
end  ; 
else    call    error('ce'); 

expSptr=expSptr-l ; 
end ; 


*/ 


impl imented  */ 


/*     147    < relational  opera tor>  :  : =  = 
do ; 
opStype( opSptr) =08h; 

opSptr=opSptr+l ;  /*  next  to  fill  */ 
end  ; 
/*      148  I  <  > 

do; 
opStype(opSptr) =09h; 
opSptr=opSptr+l ; 
end  ; 
/*     149  I  <  = 

do; 
opStype(  opSptr) =0ah; 
op$ptr=opSptr+l ; 
end  ; 
/*     150  I  >  = 

do; 
opStype(opSptr) =0bh; 
opSptr=opSptr+l ; 


*/ 


*/ 


*/ 


*/ 
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end ; 
/*  151  ,    <  ^/ 

do  ; 

ops type (opSptr) =Och; 

opGptr  =  opSptr+l ; 
end ; 
/*  152  ,    >  ^/ 

do  ; 

opStype(opSptr) =0dh; 

opSptr=opSptr+l ; 
end ; 
/*  153  I     in  %/ 

do  ; 

opStype(opSptr) =0eh; 

opSptr  =  opSptr+  1 ; 
end ; 

/*  154         <  term>     ::=    <factor>  %/ 

« 
/*  155  I    < term>    <multiplyins    operator>    <factor>  */ 

do  ; 
opSptr=opSptr- 1 ; 
if    checkSexprsStype    then 
do; 
if    opGtype(opSptr)=Oh    then   /*    multiplication    */ 
do    case    expStype( expSptr) ; 
call    error('ce');    /*   case    0   -    ord    */ 
call    g^enera  te(  mul  i)  ;    /*    case    1    -     integer    */ 
call    error (' ce ') ; 

call    genera te( mulb) ;    /«   case    3   -    real    %/ 
call    error('ce');    /*    case    4   —    string   */ 
call    error('ce');    /*   case    5    -    boolean   */ 
end;    /*    of    mul    case    */ 
If    opStype(opSptr) = Ih    then   /*    real    division   */ 
do    case    expStype( expSptr) ; 
call    error('ce');     /*    case    0    -    ord    •*/ 
do;    /«    case     1    -    integer    with   real    result    */ 
call    genera te( cnvi) ;    /*   convert    1st    integer    */ 
call    genera te ( cn2i) ;    /*    convert    2nd    integer    */ 
call    genera te( d ivb) ; 
expStypeC  expSptr- 1) =uns  ignSexpon; 
end  ; 
call    error('ce');    /*   case    2   -    char    */ 
call    genera te( divb) ;    /*    case    3    -    real    */ 
call    error('ce');    /*   case    4   -    string   */ 
call    error('ce');    /*   case    5    -    boolean  */ 
end;    /*    of    div   case    */ 
If    opStype(opQptr) =2h    then   /*    integer    divide    */ 
if    e xpS type ( expSptr) =     integers type    then 

call    genera te ( d ivi) ; 
else    call    error('ce'); 
if    opStype(opSptr) =3h    then   /*    integer    mod    */ 
if    expStype( expSptr) = integerStype    then 

call    genera te( dcr i) ;    /*    "mod"    not     imp  1 imented    */ 
else    call    error('ce'); 
if    opStype(opOptr) =4h    then   /*   boolean   and    */ 
if    expStype( expSptr) =boo leanStype    then 

call    genera te( andx) ; 
else    call    error('ce'); 
end; 
else    call    error('ce'); 
expSptr=expSptr-l ; 
end  ; 

/*  156         <multiplying   operator>     ::=    *  */ 

do  ; 
opStype( opSptr) =0h; 
opSptr  =  opSptr+l ; 
end; 
/:>:  157  I    /  */ 

do; 
opStypeC  opSptr) =01h; 
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opSptr=opSptr+l ; 
end; 
/*     158 
do  ; 

opStype(opSptr) =02h; 

opSptr=opSptr+l ; 
end ; 
/*     159 
do; 

opStype(opSptr) =03h; 

op5ptr=opSptr+ 1 ; 
end ; 
/*     160 
do  ; 

opStype(opSptr) =04h; 

opSptr=opSptr+l ; 
end ; 

/*  161         < simple    express ion>     ::=    < term> 


I    d  1 V  i^/ 


I    mod  */ 


and  */ 


*/ 


/*  162  I    <sign>    < term>  */ 

if    signtype    =    neg    then 
do; 
if    expStype(expSptr)=unsignSexpon    then 

call    genera te( negb) ; 
else     if    expGtype(expSptr) = integerStype     then 

call    genera te( negi) ; 
else    call    error('uo'); 
end ; 
/*  163  I    <simple    express ion>  */ 

/*  163  <adding   operator>    < term>  */ 

do ; 
opSptr=opSptr— 1 ; 
if    checkSexprsStype    then 
do  ; 

if    opStype<opSptr) =5h    then   /*    arith   add    */ 
do    case    expO type ( expSptr ) ; 
call    error('ce'); 

call    genera te( add i) ; /*    case     1    -    integer    */ 
call    error('ce');    /*    case    2   -    char    */ 
call    genera te( addb) ;    /*    caseS    -    real    */ 
call    error('ce');    /*    case    4    -    string    */ 
call    error('ce*);    /*    case    5    -    boolean   */ 
end;    /*    case    */ 

if    opStype(opSptr) =    6h    then   /«    arith   subtrc    */ 
do    case    expStype( expSptr) ; 

call    error('ce');    /*    case    0   -    ord    type    */ 

call    genera te( sub i) ; 

call    error('ce'); 

;     /*    call    generate(subb) ;    */ 

/*    not     implimented    */ 
call    error( ' ce ' ) ; 
call    error( ' ce ' ) ; 
end; 

if    opStype( opSptr) =7h    then   /*    boolean    or    */ 
do; 
if    expStype( expSptr) =boo leanStype    then 

call    genera te( bor) ; 
else    call    error('ce'); 
end; 
end ; 

else    call    error('ce'); 
expSptr=expSptr-l ; 
end; 

/*  164         < adding   opera tor>     ::=    +  */ 

do; 

opStype( OpSptr) =05h; 
opSptr=opSptr+l ; 
end ; 
/«  165  I    -  *'' 

do ; 
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*/ 


*/ 


opStype(  opSptr)  =06h.; 

opSptr=opSptr+ 1 ; 
end ; 
/*     166  I  or 

do; 

opStype(opSptr) -07h; 

opSptr=opSptr+ 1 ; 
end ; 

/*  167         <factor>     ::=    <variable> 

do: 

if    expSptr= 1 1     then 
do ; 
call    error( 'es ' ) ; 
ca 1 1    mon3; 
end ; 
expSptr=expSptr+ 1 ; 
call     loadSvar iab le ; 
end ; 
/*  168  I    <variable>    (    < actual    para    list>    )  */ 

5 
/*  169  I    (    < express ion>    )  %/ 

/*  170  I    <set>  #/ 

/*  171  I    not    <factor>  */ 

if    expStypeC expSptr)=boo leanStype    then 

call    genera te( no tx) ; 
else    call    error('ce'); 
/«  172  t    <nuniber>  */ 

do; 
If    expSptr=ll    then 
do; 

call    error('es'); 
call    mon3; 
end ; 
expSp tr  =  expSptr+  1 ; 
if    typenum= integerStype    then 
do; 

espStype( expSptr) =  integers type ; 
al lcSqty=co  nve  rti(sp,pos)  ; 
call    genera te ( Id i i ) ; 
call    genera  te(  low(  a  1  IcSqty) )  ; 
call    genera te( high( a  1 IcSqty) )  ; 
end; 
e Ise    do  ; 

e  xpS  t  ype  (  e  xpSp  t  r )  =  uns  i  gnSe  xpo  n ; 

call    convr tbcd( sp , pos) ; 

call    genera te(  Id ib)  ; 

do    ptrptr=0    to    bcdsize-1; 

call    genera  te(  bcdnuin(  ptrptr) )  ; 
end ; 
end ; 
end ; 
/*  173  I    nil  */ 

/*    '        174  \    <string>  */ 

5 

/*  175         <actual    para    list>     ::=    <actnal    para>  */ 

/«  176  I    < actual    para    list>     ,  */ 

/*  176  < actual    para>  */ 

/*  177         <set>     ::=    < lp>    < element     list>    < rp>  */ 

/*  178         <  element    list>     ::=  */ 

/*  179  I    <xelement     li8t>  */ 
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/'f:  180         <xeleraent    list>     ::=    <element>  #/ 

5 
/*  181  I    <zelemeiit    liat>     ,    <element>  */ 

/*  182         <element>     ::=    < express ion>  */ 

/*  183  I    < express ion>    ..    < express lon>  */ 

/*  184         <soto    stmt>     ::=    <soto>    <label>  #/ 

if    lookupSpnGidC sp, lab ISentry)     then 
do  ; 

call    se taddrptr(3) 5 
call    se taddrptr( 6+byteptr)  ; 
call    generate(  low(  addrptr) )  ; 
call    genera te( high( addrptr) )  ; 
end  ; 
e Ise    do  ; 

call    error('ul'); 

call    genera te( nop) ;    call    genera te< nop) ; 
end; 

/«  185         <goto>     : :=    goto  */ 

call    genera te( br 1) ; 

/*  186         <coinpound    stint>     ::=    <begin>    <stmt    lists>    end  */ 

/*  187         <begin>     ::=    begin  */ 

/*  188         <stmt    lists)     ::=    <stint>  */ 

/*    '        189  I    <stmt     lists>     ;    <stnit>  */ 

/■»  190         <procedure    stint>     ::=    <procediire     ident>  */ 

/»  191  I    <procedure    ident>     (  */ 

/*  191  < actual    para    list>     )  */ 

/*  192         <procedure     ident>     ::=    < identifier)  */ 

/«  193         < actual    para>     ::=    < expression)  */ 

/*  194         <rec    variable     list)     ::=    <variable)  *<^ 

/*  195  I    <rec    variable     list)     ,  */ 

/*  195  < variable)  */ 

« 

/*  196         <read    stmt)     ::=    <read    head)    (    <io    list)    )  */ 


/*  197        <read   head)     ::=    read  *'^ 

do; 

writeSstfflt=false; 

allocate=false; 
end; 
/*  198  '    read  In  *^ 

do; 

writeSstmt=false; 

a  1 loca te=  true ; 
end; 

/*  199         <write    stmt)     ::=    <write    head)    (    <  io    list)    )  */ 

if    allocate     then   call    genera te( dump) ; 
/*  200  '    < write    head) 
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if    allocate     then   call    genera te( dump) ; 

/*  201        <write    head>     ::=    write 

do; 

a  1  loca te= f a  Ise ; 

writeSstrat=true; 
end  ; 
/*  202  I    write  In 

do  ; 

allocate=  true ; 

wr  i  teSs  tmt=  true ; 
end ; 

/*  203         <  io    li3t>     ::=    <file    ident>    *    ,    <var    list> 

/*    not    implimented    */ 

/*  204  I    <var    list> 


/*  213         <case    list    element>     :: 


/* 


*/ 


«/ 


*/ 


%/ 


/%  205         <var    list>     ::=    <variable>  */ 

if    writeSstmt    then   call    writeSvar; 

else    call    readSvar; 
/*  206  I    <strinff>  */ 

if    writeSstmt    then  call    wr  i  teSs  tr  ing^; 

else    do;    /*    not     implimented    */ 
end ; 
/*  207  t    <var    list>     ,    <variable>  */ 

if    writeSstmt    then    call    writeSvar; 

else    call    readSvar; 
/*  208  I    <var    list>     ,    <strins>  */ 

if    writeSstmt    then   call    wr i teSs tr ing; 

else    do;    /*    not     implimented    */ 
end  : 


/*  209         <case   stmt>     ::=    <case    express>    <case    list    elemt    list>  */ 

/*  209  end  */ 


*/ 


/*     210    <case  espress>  '•'-    case  <expression>  of 
do; 

caseSs  tmt=  true ; 
end ; 

/*  211  <  case     list    elemt     list>     :  ••  =    <case     list    e  lemen 

/*  212  I    <case    list    elemt     list>     ;  */ 

/*  212  <case    list    e lement>  */ 


t>  */ 


*/ 


214  I    <case    label    list>     :    <stmt>  */ 


*/ 


/*  215  <repetitive  stmt>  ::=  < while  stmt> 

/*  216                           I  <repeat  stmt>  */ 

/*  '   217                         I  < for  stmt>  */ 

/*  218  <with  stmt>     ::=    <with>    <rec    variable    list>    <do>  */ 

/*  218                                                    <bal    strat>  */ 

/*  219  <with>     ::=    with  */ 

/*  220  <do>     :  :=    do  *'^ 

/*  221  < while    stmt>     ::=    <while>    < express ion>    <do>    <bal    stmt>  */ 
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/*  222  <while>     ::=    while 

/*  loi  ^^""^    ^*'°*^     ''"    ^^^'•^    <control    variable>     :=    <  for    Hst> 

'^^  223  <do>    <bal    stmt> 

/*  224  <for>     ::=    for 


*/ 


*/ 


/«  225         <for    list>     ::=    < initial    value>    < to>    < final    value> 


ue>         */ 


*/ 


^*  22^  I  < initial  value>  <downto>  < final  value> 

I 

/*  227  <control    variable>     ::=    <identifier> 

/*  228  /initial    value>     ::=    < express ion>  */ 

/*  229  < final    value>     ::=    < express ion> 


I 

/*  230         <repeat    stmt>     ::=    <repeat>    <stmt    lists>    <nntil>  */ 

/*  230  < express ion>  */ 

do  ; 
repeatSptr=repeatSptr-l ; 

if    expStype(expSptr) =boo leanStype    then 
do  ; 

expSptr=expSptr-l ; 
call    genera te(  no tx)  ; 
call    genera te(  b Ic) ; 

call    generate(  low(repeatSlbl(repeatSptr)))  ; 
cal  1    genera  te(high(  repeats  lb  KrepeatSptr)  )  )  ; 
end; 
else    call    error('ce'); 
end; 

/*  231         <repeat>     ::=    repeat  */ 

do ; 

call    genera  te(  Ibl)  ; 

call    generate(  low(  lab  Icount)  )  i 

call    genera te( high( lab Icount) ) ; 

repeat$lbl(repeatSptr)=lablcount; 

lab lcount= lab Icount + 1 ;    repeat$ptr=repeatSptr+ 1 ; 
end; 

/*  232         <until>     ::=    until  */ 

/*  233        < to>     ::=    to  */ 

/*  234         <downto>     ::=    doivnto  */ 

/*  235  not    used,    overflow    indicator  */ 

« 
end;  /*   of    case    statement    */ 

end    synthesize; 


/*:(t*  error    recovery   routines  ***/ 

y  *J^  ^1*  %i*  ^i0  *if  slf  *if  *i^  aji*  %i0  *i^  *i^  *J^  sl^  *x*  •!«  *J^  *i^  «^  *1^  «^  ^J*  *l^  *t^  «i'  *s^  «f'  ^^  si'  ^  ■^  *4^  "^  ■J'  ■^  '^  ^tf  ^k  ■^  >£*  ■^  *^  ^^  *^  ^  y^  *^  *^  *^  *^  *^  *^*  ^^  *J^  *A*  ^k  *^  *^  ^t^  *i*  ^*  ^l'  s^  ^t*  **>  ^J^  >^  ^i*  «^  "^  y 

/  vU^lxJy  •!>  kb  Kb  lO*  'Wl«  vl«  *J#  kV  vJ«  •J'  sl^  •li'  VC»  ^^  sl*  *i^»jA  vlf  vCf  vi*  %V  St'  St*  ^Ji*  Sl'M*  Vi^  ■X'  ^1*  ^i'  «I*  *il>  •iV  (^  «^  •^  «^  (^  H*  *^  "^  «J*  %lj  •^  tAf  ^J»  tJ^  ,^  '^'•^'^  ^*  *^  ^»  *^  S^  •J'  •J'  ^^  "^  ^  NV  •^  St*  *>^  ^i'  S!«     X 


180 


noconflict:    proc    (estate)    byte; 

del    estate    statesize,     ( i , j , k)     indexsize; 

j=     indexK  cs  ta  te)  ; 

k=    J    +    index2(es tate)    -    1; 

do     i    =    J     to    k; 

if  readl(i)  =  token  then  return  true; 

end ; 

return    false; 
end    noconflict; 


recover:    proc    statesize; 

del    tsp    byte,    rstate    statesize; 
do    forever; 
tsp    =    sp; 
do    while    tsp   <>    255; 

if    noconf 1 ic t( rs tate : =s tates tack( tsp) )     then 

do;  /*    state    will    read    token    */ 

if    sp    <>     tsp    then   sp    =    tsp    -    I; 
return   rstate; 
end ; 
tsp    =     tsp    -    1; 
end ; 

call    scanner; 
end ; 
e  nd    r  e  c  o  ve  r  ; 


/  jijdjN  3fl  JJC  *(C  SjC  ^»  3ls  Jfv*!?  r^  3j?  ^fC?f«  3f»  Jf*  »j*  3f*  *f*  if*  ?H  »i»  vfC?f«77*  v^s^is  »f*  ?(C^,%?J*?r*  ZfZ  .jv  JjC  2S  ?K  vj^ 'T^  ^T*  *?»  't*  *l*  'N '^  JT^  'iS  'I» 'I*  m* 'S 'o  *!>  •!»  '^  *!*  'lv«f^  'f*  'N  *?*  »S  'S  "tvJICJiC^jIJj?  /fC  7(Z  / 

/***  lair   parser   routines  **»/ 

do;  /*block    for    declarations*/ 

del  ( 1 , J , k)     indexsize,     index   byte; 

initial ize :    proc ; 

call     ini t ia 1 izeSscanner ; 

call     ini t ia 1 izeSsymtb 1 ; 

call     ini t ia 1 izeSsynthes ize ; 

cal  1    t  i t  le; 
end    initialize; 

g^etinl:     proc     indexsize; 

return    indexK  s  ta  te)  ; 
end    ge  t  ini ; 

gretin2:    proc     indexsize; 

return    index2( s ta te) ; 
end    ge  t  in2; 

incsp:    proc; 

if    (sp    :=    sp    +    1)     =     length(s tatestack)     then 
call    error( ' so ' ) ; 
end    incsp; 

lookahead:    proc; 

if    no  look    then 
do; 

call  scanner ; 
no  look  =  false; 
if  list  token  then 
call  printStoken; 
end; 
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end     lookahead; 

setSvarcSi:    proc( i) ;  /«   set    varc ,    and    incrmnt    var index   */ 

dc 1  i    byte ; 

varc ( var index) = i ; 

if  (  var index: = var index+ 1)  >  lengthC varc)  then 
call  error(  '  vo  ■*  )  ; 
end  setSvarcSi; 

/*  initialize  for  input  -  output  operations   */ 
call  move(  .  rfcb  ,  .  wf  cb  ,  9)  ;       /*  put  filename  in  ^vrite  fcb  */ 
call  se  tupSintSf  i  le ;  /V-   creates  output  file  for  generated  code  */ 
ca 11  initial ize ; 

do  forever; 

do  while  true;  /*  initialize  variables  «/ 

compi  1  ing,  nolook.=  true  ; 
s  ta  te  =  s  tar  ts ; 
sp=255; 
var index, var  =0; 

do  while  compiling; 

if  s tate< =maxrno  then  /*  read  state  */ 

do  ; 

call  incsp; 

statestack.(sp)=state; 

i  =  ge  t  i  n  1  ; 

call     lookahead; 

J=  i+get  in2-l; 

do     i=i     to    j; 

if    readK  i)  =  token    then  /*    save    token  ^/ 

do;  /*    copy  accum    to    proper    position   */ 

var( sp) = var index; 
do     index    =    0    to    accum; 

call    se  tSvarcCJ  i(  accura(  index)  )  ; 
end ; 
hash(sp)     =    hashcode; 

/*    save    relative    table    location   */ 
state=read2( i) ; 
no look=  true ; 

i  =  Jl 
end ; 
else    if    i  =  J     then 
do ; 

call    error< 'np' ) ; 
if    (state    :=    recover)=0    then 
compiling    =    false; 
end; 
end; 
end ; 
else     if    state>iiiaxpno    then  /*    apply  production   state    */ 

do; 

mp=sp-ge  t  in2; 

mpp 1  =  mp+ 1 ; 

production   =    s ta te-maxpno ; 

call    synthesize; 

sp=mp; 

i  =  get  inl ; 

var lndex=var( sp) ; 

j  =  s  ta  tes  tack(sp)  ; 

do    while    (k:=applyl( i))     <>    0   and    j    <>    k; 

i=i+l; 
end; 
if    (state:=    apply2(i))=0    then   compiling    =     false; 

end ; 
else     if    state<=    maxlno    then  /*    lookahead    state    */' 

do; 

i=getinl; 

call     lookahead; 

do    while    (  k:  =  lookK  i) )    <>    0   and    token   Ok; 
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end; 
end ; 
end; 


i=i+l; 
end ; 

state=look2(  i)  ; 
end ; 

/«    push   state      */ 
else    do; 

call     incsp; 

s ta tes tack( sp) =    getin2; 
state=getinl; 
end ; 

/*    of    while    compiling'      */ 
/*of    while  true  */ 

/^of    do    forever*/ 


end ; 
end; 
eof 


/*    of    block   for    parser      */ 
/*of    block    for    declarations*/ 
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IQOh:  /iKload    point  for    trans  la  tor*/ 

/***  system    literals  ***/ 

declare  lit      literally  'literally', 

dc 1  lit' dec lare ' , 

proc  lit  'procedure', 

bdos  lit  'oil',  /--entry  point  to  disk  op.  8y3=;</ 

boot  lit  '0',  /-"K  esit  to  return  to  op.  sys .  */ 

true  lit  '1', 

addr  lit  'address', 

false  lit  '0', 

bcdGlen  lit  '8', 

intGlen  lit  '2', 

fileeof  lit  '1', 

comrecs ize  lit  '128', 

eoffiller  lit  ' lah' , 

pinrecsize  lit  '128', 

forever  lit  'while  true'; 

del      sbloc  addr       ini t ia 1 ( SOh) , 

codestrt  addr      initial(O), 

varstrt  addr      ini t ia 1(  140h) , 

progOsize  addr      initiaKO), 

nextchar  byte, 

codecount  addr      initiaKO), 

varcount  addr       initiaKO), 

ffenGbuff(80)  byte, 

codes  ize  addr     ini  t  ia  1  (  lOOk)  , />:j  adds  bytes  generated  */ 

tempaddr  addr, 

tempbyte  byte, 
combuff( comrecs ize)     byte, 

pinptr  byte       in i t ia 1 ( p inrecs ize) , 

errcount  addr      initiaKO), 

p  incode  byte , 

pinbuff  based     sbloc    (pinrecsize)   byte, 

startbdos  addr      initiaK6h),       /«ptr  to  addr  of  bdos*/ 

base  addr, 

njas  based     startbdos  addr, 

comptr  byte      initiaK255), 
curpinrecs ize  byte      ini t ia K p inrecs ize) , 

rfcbaddr  addr       ini t ia 1 ( 5ch) , 

loop  byte,  ,     n    n    ^    fss 

^^fcb(33)  byte  initiaKO,'  '  ,  '  com'  ,  0,  0  ,0  ,  0)  , 

rfcb  baaed  rfcbaddr(33)    byte, 

cspc(66)  byte, 

cspaddr(66)  addr, 

spOmax  addr,  /«    stack   pointer    mas   */ 

no  look  byte; 

del      passl  addr      ini t ia K true ) , 

pass2  byte      ini t ia K f a Ise ) 


no  pi 


nfile  byte  ini t ia K f a Ise) 


/**********************«***=^=i=*=i=****=f=*****'^'^**='=**'^-- 

/**=(c***********************«***'*=*=f=='^*****«*«^*=^**«***'^*=^*='*=''*^^^ 

y^^-u  a-lobal  procedures  '""-^s"^ 


monl :     proc ( f , a ) ; 

del  f    byte, 

a    addr ; 

go     to    bdos ; 
e  nd    mo  u  1  ; 
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mon2:  proc  (f,a)  byte; 

del       f  byte,  a  addr; 

go  to  bdos ; 
end  mon2; 

deleteGflle:  proc(a); 

dc 1  a  addr ; 

call  monl(19,a); 
end  de le  teGf  i  le ; 

makeSfile:  proc(a)  byte; 

dc 1  a  addr ; 

return    mon2(22,a); 
end    makeGf  i le ; 

setSdraa:    proc(a); 

do  1    a    addr ; 

call    monl ( 26 , a) ; 
end    se  tCdma ; 

wr tScomGrcrd t    proc(a)    byte; 

dc 1    a    addr ; 

return  mon2(21,a); 
end  wr tGcomGrcrd ; 

closeSfile:  proc(a)  byte; 

dc 1  a  addr; 

return  mon2(16,a); 
end  closeGfile; 

openSfile:  proc(a)  byte; 

del  a  addr; 

re  turn  mon2(  15 , a) ; 
end  openGf  i  le ; 

readGfile:  proc(a)  byte; 

dc 1  a  addr ; 

return    mon2(20,a); 
end    readGfile; 

de le teGpinOf i  le :    proc; 

call    de le teGf i le( rf cbaddr) ; 
end    de le teGpinGf i le  ; 

move:    proc    (a,b,l);  /sj^moves    fm  a    to    b    for    1    bytes    */ 

del  (a,b)     addr,  /«    1    <    255    bytes    */ 

(s    based    a,    d    based    b,l)    byte; 
do    while    (  l:=  1    -    1)    <>    255; 
d=s; 

b=b    +    1; 
a=a    +    1 ; 
end ; 
end    move; 

pr  int :    proc( a)  ; 

dc 1  a    addr ; 

callmonl(9,a); 
end    print; 

printchar:    proc(rasg); 
del      msg   byte; 
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call  monK  2,  msg)  ; 
end  printchar; 

error!  proc ( errcode) ; 

del  errcode   addr, 

i   byte; 

errcount  =  errcoimt  +  1; 

call  pr  int(  .  '**;i:C!' )  ; 

call  print(.'   errorG'); 

call    printchar('     '); 

call    pr  in  t  char  ( IilgliC  errcode)  )  ; 

call    pr  intchar(  loi:(  errcode  ))  ; 
end    error; 

d  iskerr :    proc ; 
do  ; 

call    print(.'disk   error  C ) ; 

go  to    boo  t  ; 
end ; 
end    d  iskerr; 

/*;.'««  file       manipulating      routines  ***/ 

se  tupOcotnOf  i  le  :  proc  ; 

if    nopinfile     then      /*    only   make    file     if    this    toggle    off    */ 

return; 
call    mo ve(  . rf cb,  .  wfcb , 9)  ; 

wfcb(32)    =    0; 
call    deleteGf ile( . wfcb) ; 
if    makeGf ile( .wfcb)    =    255    then 
call    diskerr; 
end    se tupScoraCf i le ; 

wr iteGcomGf i le :    proc; 
if    nopinfile     then 

re  turn; 
call    se tGdma( . combuf f > ; 
if    wrtOcomSrcrd( . wfcb)    <>    0    then 

ca 1 1    d  iskerr ; 
call    se  tCdnia(  sbloc)  ;  /*   reset    dma    addr    */ 

end    wr i teScomSf i le ; 

emit:    proc ( objcode) ; 
del    objcode    byte; 

if    (comptr    :=    comptr+1)     >=    comrecs ize    then 
/*   write    to    disk   */ 
do; 

call    writeGcomSf lie; 
c  o  mp  t  r    =    0 ; 
end ; 
combuf f( comptr)     =    objcode; 
end    emit; 

generate:    proc( objcode) ; 
del    objcode    byte; 

codes ize    =    eodesize+1; 

call    emi t( objcode )  ; 
end    generate; 

genSfive:    proc( a , b, c , d, e) ; 
del    (a,b,c,d,e)    byte; 
codesize    =    codes ize    +    5; 
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call  emi  t ( a) 
call  emi  t  (  b) 
call  eini  t(  c) 
ca  11  emit(d) 
call  emi  t ( e) 
e  nd  ge  nC  f  i  ve  ; 


gten:  proc ( a , b , c , d , e , f , g, h, i , j ) ; 

del  (a,b,c,d,e, f ,g,h, 1, J)  byte; 

codesize  =  codesize  +  10; 

call  emit(a) 

call  emi  t ( b) 

call  emi  t(  c) 

ca  1  1  emi  t  (  d) 

ca  1 1  emi  t  (  e) 

call  emi  t  (  f ) 

call  emit(s-) 

call  enit(h) 

call  emi  t  (  i ) 

call  emi  t  (  J  ) 
end  gten; 


c  loseOcomGf i le  :  proc  ; 
/*  closes  a  file  */ 
if  c  loseOf i le(  .wfcb) 
call  diskerr; 

end  c loseGcomGf i le ; 


=  255  then 


openOpinOf i le :  proc; 

call  move( . ' pin' , rfcbaddr+9 ,3) ; 
rfcb(32)  =  0; 

if  openGf i  le( rf cbaddr)  =  255  then 
do; 

call  print(.'no  intermediate  file  found  S'); 
go  to  boot; 
end ; 
end  openGpinOf i le ; 


rewindCp  inGf  i le : proc ; 

re  turn; 
end  rewindGpinGf i le ; 


/*  cp/m  does  not  require  any  action  */ 
/*  prior  to  reopening  */ 


readGpinGf i le : proc  byte; 

dc 1      dent  byte ; 

if    (dent :=readGf ile(rfcbaddr) )     >     fileeof    then 
ca 1 1    d  iskerr ; 

re  turn    dent ; 
end    readGpinGf i le ; 


ge tSnextGbyte :     proc    byte; 
del       addeof    data('l'); 
nextGpinGchar 5     proc    byte; 

return    pinbuf f (plnptr) ; 
end    nextGpinSchar ; 

checkfile:    proc    byte; 
do     forever; 

if    (pinptr     :=    pinptr    +    1)     >=    curpinrecs ize    then 
do ; 

pinptr    =    0; 

if    readGpinGf ile    =    fileeof    then 
re  turn    true ; 
end ; 
nextcfaar    =    nextOpinGchar ; 
return    false; 
end ; 
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end    checkf  i  le  ; 

if    chechfile    or    (nestchar    =    eoffiller)       then 
do; 

call    move( . addeof ,    sbloc,     1); 
pinptr    =    0; 

nestchar    =    nextOp iaCchar ; 
end ; 
return   nestchar; 
end    ge tGnestSbyte ; 


ge tGnestGaddr :    proc    addr; 

del    (  lo'.ira  ,  higha  ,  tadd)    addr; 

Iowa    =    doub le( ge tOnestObyte) ; 

higha    =    doub  le(  ge  tCne2£tCbyte) 

tadd    =    shKhigha.S)  ; 

tadd    =     tadd    +     lovva; 

re  turn    tadd ; 
end    ge tGnextGaddr ; 


/***  general         procedures  ■H'^-li/ 


/*  popGsvGaddr 
/*  from  the  st 
/^.i  address  ind 
/*    total    numbe 

popGsvGaddr:  p 
del  a  addr 
call  gener 
call  gener 
call  gener 
call  gener 
call  gener 
call  gener 
call    gener 


removes    the    first    two    bytes    */ 
ack   and    saves     them    in    the  */ 

icated    as    a    parameter.  */ 

r    of    bytes    generated    =    7  */ 

roc( a) ; 


end    popGsvSadd 


ate(21h) ; 
ate(  low(a)  )  ; 
a  te ( high( a) ) 
ate(Oclh)  ; 
ate(71h) 
ate(23h) 
ate(70h) 
r ; 


/*  Ixi  */ 

/*  storage  place  */ 

/*  pop  b  */ 
/*  movm  c  */ 
/«  ins  h  */ 
/*  movm  b  */ 


/:;:  pushGsvCaddr  returns  the  address  from  ^/ 
/«  the  specified  address  to  the  stack.  */ 
/«  total  number  of  bytes  generated  =7      */ 

pushGsvGaddr :  proc(a); 
dc  1  a  addr ; 

call    generate(21h) ;  /*    Ixi    */ 

call    generate(  low(a) )  ;  ^^^   retrieving   addr    */ 

call    generate(high( a) ) 
call    genera  te(  4eh) 


call    generate(23h) 
call    genera te(  46h) 
call    genera te( 0c5h) 
end    pushGs vGaddr ; 


/* 
/* 
/* 

/* 


mo  vc    m   */ 

inx   h   */ 

mo  vb    m   */ 

push   b    */ 


/*    popCint  removes    the    first     two    bytes    */ 

/*    from    the    stack   and    saves    them    in    the 
/«    address     indicated    as    a    parameter. 
/*    total    nu.-uber    of    bytes    generated    =    7 

popSint:    proc(a); 
dc  1    a    addr ; 


*/ 

*/ 
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end 


call 

genera te(21h)  ; 

/* 

Ixi  h  «/ 

call 

£,-3  ne  r a  t  e  (  1  o  wi  a )  )  ; 

/;ic 

addr  of  int 

call 

genera te( highC  a) )  ; 

call 

Sanera te( Oc Ih) ; 

/^ 

pop  b  */ 

call 

genera  ie(  7ih.)  ; 

/« 

movm  c  */ 

call 

genera  te(231i)  ; 

/* 

inx  h  «/ 

call 

genera te(70h)  ; 

/« 

movm  h    ^/ 

popOint ; 

/5o      pushOint  returns    the    integer    from      */ 

Z^:    the    specified    address     to     the    stack.  */ 

/*    total    number    of    bytes    generated    =    7  */ 

pushOintJ    proc(a); 
dc 1    a    addr ; 

call    senerate(21h) ;  /*    Izi    h   */ 

call    genera  te(  lov/(  a)  )  ;       /*    addr    of     int    */ 
call    genera te ( high(  a)  )  ; 
genera  te  (  4eh) 


call 
call 
call 
call 


end    pushSint; 


genera  te( 23h) 
genera  te  (  46h) 
genera  te( Ocoh) 


move    ra   */ 
inx    h   */ 
movb    m   ^/ 
push   b    */ 


/*  pop3bcd  removes  the  las  t  S  bytes  from  the  */ 
/5S  stack  and  places  them  in  the  working  area  '^/ 
/^  starting  at  address  a  which  is  passed  as  */ 
/*    a    parameter    by    the    user.  JK/ 

/*    total    nuitiber    of    bytes    generated    =    23  */ 

/*y{**«;i{«**;■c«^5:;,^«*^•::fc*;,^;;c^■:;,•::^^.-ic;,^:;■:.•S*.•i:^■:*:!«********:;:*>f^:S/ 
popObcd:     proc(a); 

del     i    byte,    a    addr; 
call    genera te  (  2 Ih)  ; 
call    genera  te(  low(  a)  )  ; 
call    genera te( high(  a) )  ; 
do     i=l     to    4; 

call    genera te(  Qc Ih) 
call    genera te  (  7 Ih) 
call    genera te(  23h) 
genera  te(  79h) 
genera  te(  23h) 


end 


call 
call 

end ; 

popGbcd ; 


/T> 

Ixi   h  --it/ 

/*  addr  of 

/% 

pop  b  */ 

/« 

mo  vm  c  */ 

/* 

inx  h  «/ 

/* 

mo  vm  b  '^/ 

/* 

inx  h  */ 

bed    «/ 


/*  pushObcd  place 
/*  ber,  whose  las 
/*  as  a  parameter 
/*    total    number    o 

pushCbcd:    proc(a) 
dc 1     i    byte ,    a 
call    generate 
call    generate 
call    genera  te 
do     i= 1     to    4; 
call    gene 
call    gene 
call    gene 
call    gene 
call    %^Ta.& 
end ; 
end    pushGbcd; 


s    the    3   bytes    of    a    bed    num-    */ 
t    array   address    a    is    passed    */ 
by    the    user,     into     the    stack*/ 
f    bytes    generated    =    23  ">(■/ 


addr; 
(21h)  ; 
(  low(a)  )  ; 
(high(a))  ; 

ra  te( 46h) 
ra te(2bh) 
ra  te(  4eh) 
rate(2bh) 
ra  te( 0c5h) 


/*    Ixi    h   */ 

/*   addr    of    bed    */ 


/*  movb    m   */ 

/*  dcx    h   «/ 

/*  move    m   'f-/ 

/*  dcx    h   */ 

/*  push   b    */ 


/**  :f{  :fc  **  ^  ;jc  ;f;  >ij  *  5;j>fc  *  ^  >ij  *  ^  ;f{  *:(!*  XT*  **  JR  ^  >i<  *  ;iJ  **>;:*  Jf; :(;  ;^:S  *;(;*  ^  *  ;K  5*c  / 
/*    complSbcd    complements    a    bed    number    located    */ 
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/*  at  the  v7orkin~  area  in  loc 

/*  address  a  passed  as  a  para 

y-i'  dress  of  the  first  byte  of 

/:;'  total  number  of  bytes  gene 

complObcd:  proc(a); 

del  i  byte,  a  addr; 

call  genera te ( 21h) ; 

call  ge  ne  r  a  t  e  (  1  o  Z'K  a )  )  ; 

call  genera te( high( a) ) ; 

call  genera te( 3ah) 

call  genera te(  £0h) 

call  genera te(  S&h) 

call  genera te  (  77h) 

call  genera  te  (  23h) 

do  i=l  to  7; 

call  genera te(  3ah) 
call  genera te( 99h) 
call  genera te ( 96h) 
call  genera  te  (  ?71i) 
call    genera  te  (  23h) 

end  ; 
end    coraplGbcd; 


ation   of    2,     the       ^Z 

meter     is     the    ad-    -'^Z 

the    number    array*/ 

rated    =    43  «/ 


/*    Ixi    h    */ 

/*    addr    of    bed    */ 

/*    Idi    «/ 
/:(:    1G08O800    */ 
/*    add    m   */ 
/*   movm  a    */ 
/*    ins    h   «/ 

/*    Ida    «/ 
/*    99       «/ 
/*    sub    m  5rf/ 
/*    movm   a    */ 
/*    inx    h   */ 


/*  multOint    pops 

/■!'•  stack   and    mult 

/■^'  pushes    the    res 

/*  total    number    o 

multSint:    proc(a) 
dc  1    a    addr ; 


two     integer    numbers    from    the    */ 
iplies     them    together    .     then      */ 
lilting    integer    back    in    the    stack   */ 
f    bytes    generated    =    40  ft/ 

;!j:f:*;!C*;.^***S::i:********:.^***5!t:!!5i{^;j«5{c^/ 


call 

generate 

[Odih] 

; 

call 

genera  te 

;Oclh) ; 

call 

genera  te 

:Gc3h) : 

call 

genera  te 

,  1 0  w(  a 

+    24h) ) 

call 

genera  te 

. highC  a 

+    24h) 

call 

genera  te 

>79h) 

call 

genera  te 

'  93h) 

call 

generate 

[78h) 

call 

generate 

[9ah) 

call 

genera  te 

'0f2h) ; 

call 

genera  te  ( 

low(  a 

+    llh) ) 

call 

genera  te 

high(a 

+    llh) 

call 

generate 

60h)  ; 

call 

genera  te 

69h)  ; 

call 

generate 

Oebh) ; 

call 

genera te( 

44h) 

call 

genera  te 

4dh) 

call 

genera  te( 

21h) 

call 

generate* 

8Qh) 

call 

genera  te 

O0h) 

call 

generate 

0ebh)  ; 

call 

genera  te  < 

'7Sh) ; 

call 

genera tei 

0b Ih) ; 

call 

genera  te 

.0c8h)  ; 

call 

generate 

:8ebh) ; 

call 

generate 

.78h) 

call 

generate 

:  ifh) 

call 

generate* 

'47h) 

call 

genera  te 

'79u) 

call 

genera  te< 

Ifh) 

call 

genera  te 

'4fh) 

call 

genera  te 

9c2h) ; 

call 

generate* 

19h)  ; 

call 

genera  te< 

Oebh)  ; 

call 

genera  te 

29h)  ; 

call 

genera  te 

0c3h)  ; 

call 

genera  te 

OfSh) : 

call 

genera  te< 

1 0  w(  a 

+    5))  ; 

call 

generate 

, high( 

a 

+    3))  ; 

/*  pop    b    */ 

/«  Jmp    */ 

'  ; 

' )  ; 

/*  mova    c    */ 

/*  sub    e    */ 
/*mo  va    b    ^/ 

/*  sbb    d    */ 

/«  jp    */ 

'  )  ; 

/*  movh   b    */ 

/*  movl    c    */ 

/■»  xchg   */ 

/«  raovb    h   */ 

/*  move     1    */ 

/*  Ixi    h   :!=/ 


/* 

/* 
/« 
/* 
/* 
/* 
/* 
/* 
/« 
/« 
/* 
/* 
/« 
/« 
/* 
/* 
/« 


xchg   */ 
rao  va    b    */ 
ora    c    */ 
rz    */ 
xchg   */ 
mova    b    */ 
rar    */ 
movb    a    */ 
mova    c 
rar    */ 
move    a 
J  nc    «/ 
dad    d    Wc/ 
xchg    */ 
dad    h   */ 
jmp    «/ 
call    */ 


«/ 
*/ 
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call    genera  te  (  8d5ii)  ; 
e  nd    mu 1 i  0  i  n  t ; 


/*    push   d    */ 


/%  divGint    pop£3     two    integer    numbers    from   */ 

/*  the    stacli,     divides     the    second    number       */ 

/*  reicoved    by    the    first    nuiiiber    reiiioved         =i=/ 

/%■  and    returns     the    result     to    the    stack         */ 

/*  total    number    of    bytes    generated    =    34      */ 

divCint:  proc(a); 

dc 1  a  addr ; 

call    sten(Gdlh,0clh,0c3h, low(a+50) ,hiffh(a+50) , 7ah,2f h, 57h, 7bh, 2f h) ; 

call    sten(5fh, 13h, 2 Ih, 03h, GOh, 3eh, llh.OeSh, 19h,0d2h) ; 

call    genera  te(*  low(  a    +    23)); 

call    ganerate(    high(a    +    23)); 

call    sten(Oe3h,Oelh,0f5h,79h, 17h,4fh,78h. 17h.47h,7dh) ; 

ca  1  1    gten(  17h,3fh,7ch,  i7h,  571i,  OT  Ih,  3dh,  Qc2Ii,  low(a+17)  ,hish(a+17)  )  ; 

call    gten( 0b7h, 7c h, 1 f h, 57h, 7dh, 1 f h, 5f h, Oc9h, Ocuh, low( a+5) ) ; 

call    generate(     high(a    +    5)); 

call    genera te( 0c5h) ; 
end    di vGint ; 


/;f^^f«J!^*>ic*********;(!^ 


ItGint  compare 
the  stack  and 
if  the  compari 
comparison  is 
total  number  o 

1 tO  int :  proc ( a)  ; 
dc  1  a  addr ; 
call  generate 


s  the  next  two  integers  in  */ 

returns  a  1  to  the  stack  */ 

son  is  true  or  a  0  if  the  */ 

false.  */ 

f  bytes  generated  =  23  */ 


call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 
call 


end  ItCint; 


genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
generate 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
generate 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 
genera  te 


(Odlh) 

(Oclh) 

(79h) 

(93h) 

(4fh) 

(7Sh) 

(9ah) 

(Gd2h)  ; 

(  low(  a    + 

(high(a    + 

(Oeh) 

(Olh) 

(G6h) 

(OOh) 

(Ocoh)  ; 

(0c3h)  ; 

(  1  o  w(  a    + 

(high(a    + 

(Oeh) 

(QOh) 

(06h) 

(00h) 

(0c5h) 


/* 
/* 
/% 

/% 
/* 
/« 
18))  ; 
18)  ) 
/* 

/% 

/% 

/« 

23))  ; 

23)  ) 

/% 

/% 


pop    d    */ 
pop    b    */ 
mo  va    c    'f-/ 
sub    e    «/ 
move    a    */ 
mova    b    */ 
sbb    d    ^/ 
jnc    */ 


mvi    c    */ 

mvi    b    */ 

push   b    */ 
jmp    */ 

rav  i  c  */ 
mvi  b  */ 
push   b    */ 


/*    leSint    compares    the    next     two  integers     in         */ 

/"if.    the    stack   and    returns    a    1    to  the    stack  */ 

/«    if    the    comparison    is     true    or  a    0    if    the  */ 

/*    comparison    is    false.  */ 

/*    total    number    of    bytes    generated    =    23  */ 

leSint :  proc( a) ; 
dc 1  a  addr ; 

call    genera te( 0c Ih) ;  /*  pop    b    */ 

call    genera te ( Od Ih) ;  /«  pop    d    */ 

call    genera te(79h)  ;  /*  mova    c    ^'f-/ 
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end 


ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
c:il 
ca  I 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  i 
ca  1 
leJ 


genera 
genera 
genei^a 
genera 
genera 
genera 
gsnai'a 
gone --a 
genera 
genera 
genera 
ger.sra 
1  genera 
gsnsra 
genera 
genera 
genera 
genera 
genera 
genera 


1 
1 
1 
1 
1 
1 
1 
int 


te(93h) 

te(4fh) 

te(7Sh) 

te(9ali) 

te(0dah)  ; 

t  e  (  1  o  w(  a 

te ( highC  a 

te(Oeh) 

te(01h) 

te(06h) 

te(301i) 

teCOcSh);  /« 

ie(  QcGii)  ;  /:.'= 

te(  low(a    +    23)  )  ; 

te(higli(a    +    23)  ) 


/>:: 

svib 

e 

:,s-/ 

/« 

move 

a 

'■a/ 

/* 

mova 

b 

:;;/ 

/>(: 

sbb 

d 

*/ 

/*     jc 

*/ 

8))  ; 

IS)  )  ; 

/•.:; 

r:^'i 

c 

•«/- 

/''.'    luvi    b    '-i'/ 


push,   b    */ 
jmp    ^/ 


te(Oeh) 
te(QOh) 
te( Ooh) 
teOOli) 
te  (  DcSli) 


/*    ravi    c    ^/ 


/''.'    nivi    b    -i'/ 


/^    push    b    */ 


/u>  gtOiut    compares     the    ne 

/5"<  the    stack   and    returns 

/''■?■  if    the    comparison    is     t 

/*  comparison    is     false. 

/*  total    number    of    bytes 

gtGint!    proc(a); 
do  1    a    addr ; 
call    generate(Oc  111)  ; 
call    genera te( Od Ih) ; 
call    genera te( 79h) 
call    genera te ( 93h) 
call    genera te  (  4fh) 
call    genera te  (  78h) 
call    genera te ( 9ah) 
call    genera te( 0d2h)  ; 
call    generate(lo'w(a    + 
call    genera te ( high(  a 
call    genera te( Oeh) 
call    genera te ( 0 Ih) 
call    genera te(  06h) 
call    genera te(  G0h) 
call    genera te ( Gc5h) ; 
call    genera te ( 0c3h) ; 
call    genera  te(  low(  a 
call    genera te ( high(  a 
call    genera te(  Oeh) 
call    genera te  (  00h) 
call    genera te  (  06h) 
call    genera te  (  00h) 
call    genera  te ( 0c oh)  ; 

e  nd    g  t  C  i  n  t ; 


^>(C*^**: 

;  *  It;  ^'".^  *  >j;  jf;  *  *  :S  >;!  * 

W^SS/ 

zt     two 

integers     in 

«/ 

a     1    to 

the    stack 

«/ 

rue    or 

a    0    if    the 

genera 

ted    =    23 

*/ 

IS  « >S  >rc  *  :S  sj;  >;: «  *  Jjc :;« :iJ  :pc  5f<  *  JtJ  ;tS  !o 

;jc>f;^/ 

/i^ 

pop    b    */ 

/« 

pop    d    */ 

/:,^ 

mo  va    c    */ 

/« 

sub    e    */ 

/* 

move    a    ^/ 

/* 

mo  va    b    :K/ 

/:;; 

sbb    d    */ 

/* 

jnc    --.'i/ 

18))  ; 

+    18)) 

/:K 

mvi    c    */ 

/*  ravi    b    */ 

/*  push   b    */ 

/■»  J  rap    */ 
23))  ; 
+    23) ) ; 

/«  mvi    c    ^V 

/*  mvi    b    */ 

/«  push   b    */ 


/*    geGint    compares     the    next    two     integers     in  */ 

/*    the    stack   and    returns    a    1    to     the    stack  */ 

/*    if     the    comparison    is     true    or    a    0    if    the  */ 

/*    comparison    is    false.  */' 

/*    total    number    of    bytes    generated    =    23  */ 

geOint:    proc(a); 
dc  1    a    addr ; 
call    genera te ( Od Ih) 
call    genera te( 0c Ih) 
call    genera te  (  79h) 
call    genera te  (  93h) 
call    genera te( 4fh) 


/« 

pop    d    */ 

/* 

pop    b    */ 

/« 

mova    c    */ 

/* 

sub    e    */ 

/* 

move    a    */ 
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end 


call 

genera  te(  7Sli) 

;                    /« 

mova    b    */ 

call 

genera  te(  9aii) 

;                       /» 

sbb    d    */ 

call 

genera te( Qdah) ;               /« 

jc    «/ 

cal  1 

genera  te(  low(  a    +    18)); 

call 

genera  te( high< 

a    +    18) ) 

call 

genera  te(  Oeh) 

/* 

mv  i    c    «/ 

call 

generate( Olh) 

call 

genei-a  te(  Cob.) 

/* 

mvi    b    «/ 

call 

genera  te(  OOli) 

call 

genera  te( Oc oh] 

;               /* 

push   b    */ 

call 

genera te( 0c3h] 

;                  /* 

jmp    «/ 

call 

genera  te(  low(  a    +    23)); 

call 

genera  te( high< 

a    +    23)  ) 

call 

genera  te( Geh) 

/« 

mv  i    c    */ 

call 

genera  te( GOh) 

call 

genera te( Q6h) 

/* 

ravi    b    •■i--/ 

call 

genera  te( OOh) 

call 

genera  te(  OcohJ 

;             /* 

push   b    */ 

geOint; 

/*    eqOint    compares     the    nest     two     integers     in  */ 

/*    the    stack   and    returns    a    1    to    the    stack  */ 

/*    if    the    comparison    is     true    or    a    0    if    the  */ 

/*    comparison    is    false.  */ 

/*    total    nu.-nber    of    bytes    generated    =    24  */ 

eqOint:     proc(a); 
del    a    addr; 

call  genera te ( Od Ih) 

call  genera te( Oc Ih) 

call  genera  te  (  79h) 

call  genera te ( 93h) 

call  genera te( 4fh) 

call  genera te ( 78h) 

call  genera te( 9ah) 

call  genera te( Ob Ih) ; 

call  genera te( 0c2h) ; 

call  genera  te(  low(a 

call  genera te( high( a 

call  genera  te(  Oeh) 

call  genera te ( 0 Ih) 

call  genera te( 06h) 

call  genera te ( GOh) 

call  genera te( Oc5h) ;  /*    push   b 

call  genera te(Gc3h) ;  /*    Jmp    */ 

call  genera te( low( a    +    24)); 

call  genera te ( high( a    +    24)); 


/* 

pop 

d    «/ 

/:,': 

pop 

b    «/ 

/« 

mova 

c    «/ 

/5i; 

sub 

e    */ 

/« 

move 

a    */ 

/« 

mova 

b    «/ 

/« 

sbb 

d    «/ 

/>x 

ora 

c    «/ 

/* 

jnz 

«/ 

19))  ; 

19)) 

/* 

mvi 

c    */ 

/«  mvi  b  */ 


*/ 


call  genera te ( Geh) 
call  genera te( OOh) 
call  genera te ( 06h) 
call  genera te ( OOh) 
call  genera te( 0c5h) 
e  nd  e  qO  i  n  t  ; 


/*  mvi 


*/ 


/*  mvi  b  */ 
push  b 


/* 


*/ 


/*  neSint  compares  the  next  two  integers  in  */ 

/*  the  stack  and  returns  a  1  to  the  stack  */ 

/*  if  the  comparison  is  true  or  a  0  if  the  */ 

/*  comparison  is  false.  */ 

/*  total  number  of  bytes  generated  =  24  */ 

neGint:  proc(a); 
dc  1  a  addr ; 
call  genera te ( 0d Ih) 
call  genera te ( 0c Ih) 
call  genera te( 79h) 
call  generate( 93h) 
call  genera te(  4fh) 
call  genera te( 78h) 


/* 

pop    d    */ 

/* 

pop    b    */ 

/* 

mova    c    */ 

/« 

sub    e    «/ 

/* 

move    a    */ 

/* 

mova    b    */ 
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end 


call 

senera  te(  9ah) 

;                    /* 

sbb 

d    */ 

call 

genera  te(Gi>lh)  ;               /* 

ora 

c    */ 

call 

genera te(0c2h 

;                 /* 

jnz 

*/ 

call 

genera  te(  low(  a    +    19)); 

call 

genera  te( high< 

a    +     19)) 

call 

genera  te(  Oeli) 

/* 

mvi 

c    :.■=/ 

call 

genera  te(  0  111) 

call 

genera  te( 06h) 

/« 

mvi 

b    */ 

call 

genera te( OOk) 

call 

genera  te(  Ocoh] 

;                    /* 

push   b    */ 

call 

genera  te  ( Oc3h] 

;                  /* 

Jmp 

^/ 

call 

genera  te(  loTv(  a    +    24)); 

call 

genera  te(  iiigh( 

a    +    24')  ) 

call 

genera te( Oeh) 

/* 

mvi 

c    */ 

call 

genera  te( Q0h) 

call 

genera  te( 06h) 

/* 

mvi 

b    */ 

call 

genera  te( OOh) 

call 

genera  te  (  Ocoh) 

;                  /* 

push   h    */ 

ne  G  i  n  t ; 

/*    notCbool    nega ces    a     '0'     to    a     '1'    and    a  */ 

/*  *I'  to  a  '0'  taking  the  last  byte  of  the  «/ 
/^  stack  and  returning  its  complement  to  the*/ 
/*    stack,     total    number    of    bytes    =     19  */ 

notObool:    proc(a); 
dc  1    a    addr ; 

genera te(Oc lb) ;  /* 

genera  te  (  791i)  ;  /* 

generate( Of h) ;  /* 

generate( 0d2h) ;  /* 
generate(low(a  +  14)); 
genera te ( high( a    +     14)) 

genera te(Oeh) ;  /« 


ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 
ca  1 


pop    b    */ 
mova    c    */ 
rrc    */ 
jnc    «/ 


mvi    c    */ 


genera  te ( 80h) 

genera  te ( 06 h) 

genera  te ( OOh) 

genera ie ( Oc3h) ;  /* 

genera  te  (  0c3h)  ;  /* 

genera  te  (  low(  a    +     19)); 

genera te( high( a    +    19)) 


/«    mvi    b    */ 


push   b 
jmp    */ 


*/ 


genera  te  (  Oeh) 
genera  te ( OOh) 
generate ( 06 h) 
genera  te  (  OOh) 
genera  te( 0c 5h) 


/*    mvi    c    */ 


/* 


/* 


mvi    b    «/ 
push   b    */ 


end    no  tGboo 1 ; 


/*  andCboo 1  pops 
/*  the  stack  cal 
/5S  and  returns  t 
/*    total    number 

/  Jjs  *I?  ?[v  ^C  rf\  rf%  JjC  Jfs  7f*  »jC  JfC  rfZ  Jfs  rjZ  tfi. 

andGboo 1 :  proc(a 
dc  1  a  addr ; 
call  genera  t 
call  genera  t 
call  genera  t 
call    genera  t 


the     last    two     integers    from  */ 

culates    their    logical     'and'  */ 

he    new  value    to     the    stack.  :.'•/ 

of    bytes    generated    =    26  ^/ 

^S  'I*  ^r*  'r*  'f*  'i^  «J^  '}*  *f^  *•*  ^*  '^  *?*  *(*  'K  'iK  'T*  ***  *!*  'I^  'I'  *!•  'P  '(*  ^I^  't*  5f*  JP  3j»  / 

)  ; 


call 
call 
call 
call 
call 
call 
call 
call 
call 


genera  t 
genera  t 
genera  t 
genera  t 
genera  t 
genera  t 
genera  t 
genera  t 
genera  t 


e(0dlh) 
e(Oclh) 
e(79h)  ; 
e(0a3h) 
e(4ih)  ; 
e ( 7Sh) ; 
e(Oalh) 
e ( 47h) 
e(79h) 
e(0fh) 
e(0d2h)  ; 
e  (  1  o  w(  a  H 
e(  high(  a 


/* 

/5fC 
/* 
/* 
/* 
/* 

21))  ; 
■    21)) 


/*    pop 
/*    pop 
/*    mova 
/*    ana 
/*    move 
mova 
ana 
mo  vb 
mova 
rrc 
jnc 


d    «/ 

b    */ 
c    */ 
e    */ 
a    */ 
b    */ 

c    */ 
a    */ 
c    */ 

*/ 

«/ 
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call 

genera te(Oeh) 

/« 

mvi    c    */ 

call 

genera  te( Olh) 

call 

genera  te(  86h) 

/* 

mvi    b    «/ 

call 

Senerate(0Oh) 

call 

genera  te(  Geo h! 

;                  /* 

push   b    */ 

call 

ge  ne  r a  t  e  (  Oc  3h] 

;             /* 

jmp  ■'^y 

call 

gsnarate(  low(a    +    26)); 

cal  1 

ge  ne  r  a  t  e  (  h  i  gh( 

a    +    26)) 

call 

genera  te(  Qeh) 

/:}: 

mvi    c    ■!■</ 

call 

genera te( 0Oh) 

call 

genera  te( 06h) 

/^ 

mvi    b    */ 

call 

genera te(  OOh) 

call 

genera te(0c5h) 

;               /* 

push   b    */ 

end    andCbool; 


/''•'  orCbool  popo  the  last  two  integers  from  */ 
/*  the  stack  calculates  their  logical  'or'  */ 
/*;>    and    returns     the    new   value    to    the    stack.       ^/ 

/%    total  nu:iiber    of    bytes    generated    =    2&  */ 

or3boo  1  !  proc(a); 
dc  1    a    addr ; 

call  genera  te(  Gd  Ih)  ;  /*    pop    d    '-^Z 

call  genera te( Gc Ih) ;  /*    pop    b    */ 

call  genera  te  (  79h)  ;  /*    mova    c    =S/ 

call  genera  te  (  Gb3h)  ;  />!•    ora    e    */ 

call  genera te ( 4fh) ;  /*    move    a    ^/ 

call  genera te ( 7Sh) ;  /*    mova    b    */ 

call  generate(0b2h)  ;  /*    ora    d    -^Z 

call  genera te( 47h) ;  /*   movb    a    */ 

call  genera te( 79h) ;  /*    mova    c    */ 

call  genera te(0fh) ;  /*    rrc    */ 

call  generate(0d2h) ;  /«    Jnc    */ 

call  genera  te(low(a    +    21)); 

call  genera te ( high(  a    +    21)); 

call  genera te ( Oeh) ;  /*    mvi    c    */ 

call  genera te( 0 Ih) ; 

call  genera  te(06h)  ;  /-i^    mvi    b    */ 

call  genera te( 00h) ; 

call  genera te(0c5h) ;  /*    push   b    */ 

call  genera te( 0c3h) ;  /*    jmp    ^/ 

call  genera  te  (  low(  a    +    26)); 

call  genera te( high( a    +    26)); 


call  genera te( Geh) 
call  genera te  (  0Oh) 
call  genera te  (  06h) 
call  genera te(  Q0h) 
call  genera te(  0c5h) 
end    orGboo 1 ; 


/*  mvi  c  */ 
/«  mvi  b  */' 
/*    push   b    */ 


f  ^u  ^u  *i»  ^t^  tiM  ^if  k^  ^>  ^i»  ^te  *t»  *if*if  *3f  *i0  *if  *if  s^  *^  ^k  ^*  >j'  yt'  *^  ^k  ^^  *^  *^  ^^  >i*  ^J*  4*  ^^  *^  *^  ^/*  ^4^  '4'  ^^  *i^  ^*  V*  ^'  y' 
^  ^  ^v  ^»  ^  «f»  ^^  *^  *^  ^^  ^s  ^>  'N  ■'N  *f*  '^  •f^  "T*  ^N  ^>  ■^  ^>  'N  ^S  ^S  ^>  ^>  'f*  'o  ^N  'f*  'N  ^S  ^^  '^  ^*  'f*  't*  *r*  *>*  m*  't*  'i*  fl>  ^ 

/*  svGstack  increses  the  size  of  the  stack  */ 
/*  by  moving  the  stack  pointer  (b)  times  */ 
/*    total    number    of    bytes    generated    =    b  */ 

svSstack:    proc(b); 

del    ( i,b)    byte; 

do     i=  I     to    b ; 

call    generateObh)  ;         /*   dcx   sp   */ 

end  ; 
end    svSstack; 


/*  unsvSstack  decreases  size  of  the  stack  */ 
/*  by  moving  the  stack  pointer  (b)  times  */ 
/*    total    number    of    bytes    generated    =    b  »«/ 

unsvSstack:     proc(b); 
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del    ( i ,b)    byte; 
do     i=  1     to    b ; 
call    genera te( 33h) ; 
end ; 
end    unsvOstack; 


/'-!«    inx   sp    */ 


/*    stoObcd    stores    ei^ht    bytes    from    the  */ 

/*    stack    into    an    address    calculated    from      =i'/ 
/*    the    first     two    bytes     taken    from    the    stack   -";:/ 


/*    pop    h   */ 


/*    total    niiiiiber    of    bytes    generated    =    21 

stoGbcd:    proc ; 

dc 1     i    byte ; 

call    genera te( 0e  Ih) 

do     1=1     to    4; 

call  genera te(  0c Ih) 

call  genera te( 7 Ih) 

call  genera te( 23h) 

call  genera te(  70h) 

call  genera te(  23h) 

end ; 
end  stoCbcd; 


/* 

pop    b    */ 

/% 

inovm   c    5S/ 

/% 

inx    h   */ 

/■^^ 

nio  vm    b    */ 

/:;: 

inx    h   «/ 

/*  1 
/*  t 
/*  t 
/*  t 

lodC 


end 


>ic>ic  jj:  ;fj  ^ic  ;f;  *  *  *  S:  * 
odCbcd    remo 
he    stack    , 
he    bed    numb 
he    stack,     t 
« IS  ;jc  Jj:  *  >tc;.^  *  ;S  *  * 
bed :    proe ; 
dc 1     i    byte ; 
call    genera 
do     i= 1     to    4 
call    ge 
call    ge 
call    ge 
call    ge 
call    ge 
end ; 
lodCbcd; 


ves  the  first  two  bytes  from*/ 
calculates  the  address  of  */" 
er  and  moves  8  bytes  into  '^/ 
otal    bytes    generated    =    21         */ 


te(Oelh)  ; 

nera  te ( 46h) 
nera te( 2bh) 
nera te ( 4eh) 
nera te( 2bh) 
nera te( 0c5h) ; 


/*  pop   h   */ 

/:M  movbm    */ 

/*  dcx   h   */ 

/;K  move    m  -K/ 

/*  dcx   h  */ 

/*  push  b    */ 


/*    printSint    prints     to     the    console    the  */ 

/*    integer    specified    by    the    calling   routine    */ 
/*    total    bytes    generated    =    570  */ 

t :     proc ( a) ; 
a    addr; 

genSf ive(0c3h,  low(a+3dh)  ,high(a+3dh)  ,21h,0fh) ; 

genOf ive(01h,71h,2ch,73h,23h) ; 

gten(72h,0c3h,05h,O0h.Cc9h,21h, 12h, 0 Ih, 71h, 0eh) ; 

gten(02h,5eh, 16h, OOh. Ocdh, lowCa+Sh) ,high(a+3h) ,21h,3fh, Olh) ; 

gten(34h,3eh,4fh.96h,0d2h,  lov/(a+3eh)  ,high(a+3ch)  ,0eh,02h,  leh)  ? 

gten(Odh,  16h,  90h,  Ocdh.  low(a-!-03h)  ,high(a+03h)  ,Oeh,02h,  leh.Oah)  ; 

gten( 16h, OOh. Ocdh, low(a+03h) .high(a+03h) , 2 Ih. 3f h. 01h, 36h, 00h) ; 

gten(0c9h,21h.0eh,01h.36h,O0h,3eh,0ffh,06h,7fh) ; 

gten(  2eh,  Oeeli,  96h,  2ch,  4f  h,  78h,  9eh.  0d2h,  low(  a+66h)  ,  high(  a+66h)  ) 

gten(0eh,2dh.3cdh, low(a+Ofh) .high(a+Ofh) , Oaf h. 21h, 08h, 01h, 96h) 

Sten(2ch.4fh.3eh,00h,9eh,2dh.71h.23h,77h.0c3h) ; 

genGf  ive(  low(a+6bh)  .high(a  +  6bh)  ,  0eh,  20h,  Ocdh)  ; 

genOf  ive(  low(a  +  Ofh)  ,high(a+0fh)  .  1  Ih.  10h.27h)  ; 
gten(21h,O8h,01h,4eh.2ch.46h,Oc3h.  Iow(a+0a4h) . high(  a+0a4h) ,7ah) 

gten(2fh,57h,7bh.2fh,5fh. 13h,21h. OOh, 00h, 3eh) ; 

genOf ive(  llh.OeSh.  19h,0d2h,  low(  a+89h) )  ; 

genGf ive(hish(a+39h) . 0e3h, Oe Ih, Of 5h, 79h) ; 

gten( 17h,4fh,7Sh, 17h,47h,7dh, 17h,6fh,7ch, 17h) ; 
gten(67h.0f  lh,3dh,Gc2h,  lov/(a+83h)  ,high(a+83h)  ,0b7h,7ch,  lfh,o7h) 
gten(7dh, Ifh. 5f h. 0c9h, Ocdh,  low(  a  +  77h)  ,high(a+77h) , Oaf h,9 Ih, 5fh) 
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call  sten(3eh,GGh,9Sh,0d2h, low(a+10fh) , hish(a+ lOf h) , 2 Ih, Oeh, 01h,36h) 

call  sten(01h,  nil,  lOh,  27h,  2  Ih,  08h.  0  Ih,  4eh,  2ch,  4&h)  ; 

cal  1    3,-ten(0cdh.  low(a+77h)  ,hish(a+77h)  ,  21h,  Oah,  0  Ih,  7lli,  II  h,  10h,27h)  ; 

cal  1    stenC  2 1 li,  Oah,  0  ih,  4eh,  G6h,  OOh,  Oc3h,  low(a+0f4h)  ,  hish(  a  +  Of  4h)  ,79h) 

call    sten(93h,73h.9ali,0f2h,  lo  wCa+Oddh)  ,  highC  a+0ddh)  ,  60h,  69h,  0ebh,  44h) 

ca  1 1    sten(  'Idh,  2  Ih,  03h,  09h,  Oebh,  7ah,  0b  Ih,  OcBh,  Oebh,  78h)  ; 
call     ~^3-i(  Ifh, ':•?!;,  "CTi,  1  f  h,  4f  h,  0d2h.  low(a+Oefh)  ,  hi-hC  a+Oe  f  h)  ,  I9h,0ebh) 

c- :•  1    ~enOrive(?^'^,  0c3h,  low(a+Oe  Hi)  ,  his'li(  a+0e  Ih)  ,0cdh)  ; 

call    genGf  ive(  low(a+3dlh)  ,  higW  a+0d  Ih)  ,  21h,  ©8h.  01h)  ; 

call    a- 1  en(  7eh,  2ch,  46h,  93h,  4f  h,  78h,  9ah,  2dh,  7  Ih,  23h)  ; 

cal  1    ijteii(77h,2eli,3dh,7eh,0c6h,o0h,77h,4eh,8cdh,  lov7(a+0fh)  )  ; 

call    £jten(hia,h(a-;-Ofh)  ,  1  Ih,  CeSh,  03h,  2  Ih,  08h,  0  Ih,  4eh,  2ch,  0cdh)  ; 
call    s;eii(Gc.IIi,  io,/;  a-H?71i)  ,  hifihC  a+77h)  ,  Gaf  h,  9  Ih.  5f  h.  3eh,  OOh,  98h,  0d2h) 
call    gten( low(a+I60h) , highC a+ 16Gh) , 2 Ih, 0eh, Glh, 36h, G Ih, 1 Ih. 9e8h, 03h) 

call    gten(21h,OSh,OIh,4eh,2ch,46h,0cdh, low(a+77h)  ,high(a+77h)  ,2Ih)  ; 

call    sten(0dh,01h,71h, 1 Ih, Oe8h, 03h, 2 Ih, 0dh, Olh, 04h) ; 
call    fften(06h,0Gh,9cdh, low(a+Odlh) ,hiffh( a+Od Ih) , 21h, G8h, 01h,7eh,2ch) 

call    sieii(45h.93h,4fh,7Sh,9ah,2dh,7Ih,23h,77h,2eh)  ; 
call    gten( Odh, 7eh, 0c6h, SGh, 77h, 4eh, Ocdh, low(a+8fh) ,hish(a+Ofh) ,Gc3h) 

call    -enOi  ive(  lov/(a+I6dh)  ,  highC  a+ 16dh)  ,  2  Ih,  0eh,  0  Ih)  ; 

call    -enCf  ive(7eh,0fh,Gd2h,  low(a+I6dh)  ,  hish(  a+ I6dh)  )  ; 

cal  1    <jten(0eh,3Gh,Gcdh,  lo\Nr(a+Ofh)  .highCa+Qfh)  ,  Ieh,64h,  I6h,00h,2Ih)  ; 

call    sten(GSh,0Ih,4eh,2ch,46h,Gcdh, low(a+77h) ,hish(a+77h) ,0afh,9Ih) 
call    sten(5fh,Ceh,GGh,9Ch,0d2h, low(a+Ic Ih) ,hish(a+Ic Ih) , 2Ih, 0eh, 0 Ih) 

call    sten(36h,GIh, leh,64h, I6h, OOh, 2Ih, G8h, 0 Ih, 4eh) ; 

call    sten(2ch,46h,Qcdh, low(a+77h) ,high(a+77h) , 2 Ih, Odh,0Ih,71h, leh) ; 

call    sten(64h, 16h, GGh, 2 Ih, Odh, Olh, 4eh, 06h, GOh, Gcdh) ; 

call  gten(  lo  w(  a-i-8d  Ih)  ,  hish(  a+Od  Ih)  ,  2  Ih.OSh,  0  Ih,  7eh,  2ch,  46h,  93h,  4fh) 

call  gteu(7Sh,9ah,2dh,7Ih,23h,77h,2eh,0dh,7eh,0c6h) ; 

call    genOf ive(30h.77h,4eh,Ocdh, low(a+Ofh) ) ; 

call    genOf  ive(hish(a+Qfh)  ,0c3h,  lov(a+lceh)  ,h.is:h(  a+ Iceh)  ,21h)  ; 
call    gten(Oeh,Olh,7eh,0fh,Od2h,  low(a+lceh)  .  highC  a+ Iceh)  ,  0eh,  30h,  0cdh) 

call    gten(  low(a-!-Ofh)  ,  higM  a-rGf  h)  ,  leh, Oah,  l&h,  OOh,  21h,  08h.  Olh,  4eh)  ; 

call    sten(2ch,46h,0cdh,  low(  a+77h)  ,hish(a+77h)  ,  Gaf  h,  9  Ih,  5f  h,  3eh,  00h) 
cal  1    gteii(98h,Gd21i,  low(a+21dh)  ,  high(  av21dh)  ,  leh, Oah,  16h,  OOh,  21h,08h) 

call    fften(01h,4eh,2ch,46h,0cdh, low(a+77h) ,high(a+77h) , 2Ih.0dh, Olh) ; 

call    sten(7Ih, leh, Oah, 16h, OOh, 2 Ih, Odh, 0 Ih, 4eh, 06h) ; 
call    sten(  OOh,  Gcdh,  lovK  a  +  Od  Ih)  ,  hi2:h(  a+0d  Ih)  ,  21h,  08h,  Glh,7eh,  2ch,  46h) 

call    sten(93h,4fh,73h,9ah,2dh,71h,23h,77h,2eh,0dh) ; 
call    steii(7eh,9c6h,G0h,77h,4eh,0cdh,  low(a+Ofh)  ,hieh(a+0fh)  ,0c3h,00h) 
call    ^ten(00h,21h,Odeh,01h,7eh,Ofh,Od2h,  low(a+22ah) , high(  a+22ah) ,0eh) 

cal  1    sten(30h,0cdh,  low(a+exh)  ,  hig-M  a+Of  h)  ,  01h,  30h,  OOh,  2ah,  OSh,  0  Ih)  ; 

call    gten(O9h,0ebh,21h,0ah,01h,73h,4eh,0cdh, low(a+Ofh) , high(  a  +  0fh) ) 
end    prIntSint; 

/*    printSbcd    prints     to     the    console    a    bed  */ 

/*    number    moved    to     the    working    area    by    the  */ 

/*    calling   routine.  */ 

/*    total    number    of    bytes    generated    =    464  */ 

printSbcd:    proc(a); 
dc  1    a    addr ; 

call    gten(0c3h, low(a+3dh) ,high(a+3dh) ,2Ih, 13h, 0 Ih, 71h, 2ch, 73h, 23h) ; 
call    gten(72h,0c3h,85h,00h,Oc9h,21h, 16h, 01h,7 Ih, Oeh) ; 
call    gten(02h,5eh, 16h, OOh, Ocdh, low(a+3h) ,high(a+3h) ,2 Ih, 3f h,01h) ; 
call    gtcn(34h,3eh,4fh,96h,0d2h,  low(a  +  3ch)  ,high(a+3ch)  ,0eh,02h,  leh)  ; 
cal  1    gtenCOdh,  16h,  OOh,  Ocdh,  low(a+3h)  ,high(a+3h)  ,0eh,O2h,  leh,  Oah)  ; 
call    sten(  1 5h, OOh, Ocdh,  low(  a+3h)  ,high(a+3h)  , 2Ih, 3f h, 0 Ih, 36h, OOh) ; 
call    gten(Oc9h,3eh,3ch,2Ih,3fh,0Ih,96h,0d2h,  lovr(a+5dh)  ,high(a  +  5dh)  ) 
call    gten(0eh,02h,  leh,  Odh,  I6h,  OOh,  Ocdh,  low(a+3h)  ,high(a+3h)  ,Oeh)  ; 
call    gten(02h,  leh,  Oah,  I6h,  GOh,  Ocdh,  low(a  +  3h)  ,high(a  +  3h)  ,2Ih,3fh)  ; 
call    gten(01h,36h,00h,2eh,0fah,36h,07h,3eh,7fh,2eh) ; 
cal 1    genCf ive(08h,96h,0d2h, low(a+78h) ,high(a+78h) ) ; 
call    genOf ive(0eh,2dh,Gcdh,  low(  a+Of h)  ,high(a+0fh) )  ; 

call  sten(21h,OSh,OIh,7eh,Oe&h,80h,77h,0c3h, low(a+7dh) ,high(a+7dh) ) 
call  gten(Geh,20h,Ocdh, low(a+0fh) ,high(a+Ofh) ,2Ih, I2h, 01h, 4eh, 06h) ; 
call    gten(GOh,2eh,0Bh,09h,7eh, leh, 04h, 0b7h, Ifh,  Idh) ; 

call    gten(0c2h, low(a+89h) , highC a+89h) , 0c6h, 30h, 21h, 10h,0Ih,77h, 4eh) 
call    gten(0cdh,  low(a+Ofh)  ,hish(a+0fh)  ,  ©eh,  2eh,  Ocdh, 
low(a+0fh) ,hish(a+0fh) ,2Ih, 1 Ih) ; 
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call    grten(01h,36h,01h,3eh,06h,21h,  1  Ih,  31h»96h,  Odah)  ; 
call    gten(  low(a+0e4h)  ,  lii£,'h(  a+0e4h)  ,  02ch,  4eh,  06h,  OOh,  2eh,  081i,  09h,  7eh) 

call    sten(0e6h,9fli,0c6h,30h.21h,  18h,  91h,  77h,  4eh,  Ocdh)  ; 

call    g,-ten(  low(a+Ofh)  ,hish(a+Ofh)  ,21h,  12h,  0  Ih,  35h,  4eh,  06h,  O0h,  2eh)  ; 

call    sten(0Sh,09h,7eh, leh, C4h, 0b7h, Ifh, ldh,0c2h, low(a+0cdh) ) ; 
cal  1    gten(higli(a+Ocdh)  ,  0c8h,  30h,  21h,  IQh,  8  Ih,  77h,  4eh,  0cdh,  low(a+0fhJ  ) 

call    srten(hish(a-!-Orh)  ,21h,  llli,  0  Ih,  34b,  Oc21i,  low(a+0a3h)  ,  high(  a+0a3h) 

2eh,08h)  ; 

call    sten(23h,7eh,Oe6h,0fh,Oc6h,3©h,21h, 10h,Olh,77h) ; 

ca  1 1    gtenC  4eh,  Ocdh,  low(  a+Of  h)  ,  his-h(  a+Ofh)  ,  Of  h,  45h,  0cdh, 

low(a+0fh)  ,high(a+Ofh)  ,2Ih)  ; 
call    fften(C8h,0Ih,7eb,0d6h,83h,0d2h, low(a+l 1 Ih) ,high(a+l llh) ,0eh,2dh) 

cal  1    sten(Ocdh,  lo'.-;^(  a-;-Of  h)  ,hish(a+Ofh)  ,  3eh,  4  Ih,  2  Ih,  08h,  0  Ih,  96h,77h)  ; 

call    sten(0c3h,  lovKa+Ildh)  ,high(a+l  Idh)  ,0eh,20h, 

Ocdh, low(a+Ofh) ,high(a+Ofh) ,21h,08h) ; 

call    sten(Olh,7eh,0d6h,41h.77h, leh,0ah, 16h,G0h,21h) ; 
call    sten(OSh,Olh,4eh,OSh,0Oh,8c3h, low(a+157h) , high( a+ 157h) ,7ah,2fh) 

call    steii(o7h,71>h,2rh,5fh,  13h,  21h,  OOh,  O0h,  3eh,  1  Ih)  ; 

call    gtsn(0e5h, 19h,9d2h, low(a+13ch) , high( a+ 13ch) ,0e3h,0elh, 

0e5h.79h, 17h) ; 

call    sten(4fh,7Sli,  17h,47h,7dh,  17h,6fh,7ch,  17h,67h)  ; 

cal 1    sten(Of lh,3dh,0c2h, low(a+136h) , highC a+ 136h) ,0b7h,7ch, 

lfh,57h,7dh) ; 

cal 1    sten( 1 f h, 5ih, 0c9h, Ocdh, low(a+12ah) , high( a+ 12ah) ,0afh, 

91h.5fh,3eh) ; 
call    sten(OOh,98h,0d2h, low(a+lbeh) , high( a+ Ibeh) , leh,0ah, 16h,00h,21h) 

call    sien(OSh,Olh.4eh,O6h,OOh,0cdh, low(a+12ah) , 

hish(a+12ah)  ,21h,  low(a+lf3h)  )  ; 

call    gten(hish(a+lf3h) ,71h, Ieh,Oah, 16h,0Oh,21h, 10h,01h,4eh) ; 
call    sten(Q6h,©yh,0c3h.  lov/(a+la4h)  ,  hi£;h(  a+la4h)  ,  79h,  93h,78h,  9ah,  0f2h) 
call    gtenC low(a+13dh) , highC a+ 18dh) , 60h, 69h, Oebh, 44h, 4dh, 21h, 00h, 00h) 

call    gten(Cebh,7Sh,0blh,0c8h,0ebh,78h, lfh,47h,79h, Ifh) ; 

call    sten(4fh,0d2h,  low(a+19fh)  ,  higM  a+ 19f  h)  ,  19h,  0ebh.  29h, 

0c3h,  lo^>K  a+  19  Ih)  ,  hig:h(  a+  19  Ih)  )  ; 
call    sten(Ocdh, low(a+l81h) , highC a+ 181h) , 21h, 08h. 01h, 7eh, 93h, 4fh, 3eh) 

call    sten(09h,9ah,71h,2eh. lOh, 7eh, 0c6h, 30h, 77h, 4eh) ; 
cal  1    gten(Ocdh,  low(a+Ofh)  ,high(a+0fh)  ,0c3h,  low(a+lc3h)  ,high(  a+ lc3h)  , 

0eh,2Oh,0cdh,  low(a+0fh)  )  ; 

call    slen(hish(a+Ofh) , 2 Ih, 08h, Olh. 7eh, Oc6h, 30h, 2eh, 10h,77h) ; 

call    genera te ( 4eh) ; 

call    genera  te  (  Ocdh)  ; 

call    genera  te(  low(a+Ofh))  ; 

call    genera te ( high(  a+0fh)  )  5 
end    printCbcd; 

/*  neGbcd    logically   compares     two    bed    numbers    */ 

/*  taken    from    the    stack   returns    a    value    of    one'i^/ 

/*  if    the    numbers    are    not    equal,    a    zero     if            */ 

/*  equal,     total    number    of    bytes    gen    =    67                 */ 

neSbcd:    proc(a)  ; 

dc 1    a    addr ; 

call    eten(21h,  lah.  1 Ih, 36h, 00h, 2dh, 36h, 00h, 2 Ih,  19h)  ; 

call    gten( 1 Ih, 7eh, 0d6h,08h, 0d2h, low(a+3eh) ,high(a+3eh) , 4eh, 06h,00h) 

call    gten(2eh.0Eh,O9h,7eh,2!h, 19h, llh,5eh, 16h,00h) ; 

call    gten(2eh,  lOh,  19h,  4f  h,  7eh,  9  Ih,  0cah,  low(a+34h)  ,high(a+34h)  ,21h)  ? 

call    gten( lah, 1 Ih, 36h, Olh, 2dh, 7eh, 0c6h, 08h, 77h, 0c3h) ; 

call    gten(  low(a  +  3h)  ,hiG:h(a+8h)  .21h,  ISh,  1  Ih,  36h,  00h,  2dh,  34h,  0c3h)  ; 

call    genOf  ive(  low(a+8h)  ,high(a+8h)  ,  2ch,  4eh,  06h)  ; 

call    genera te(  00h)  ; 

call    genera te(  0coh)  ; 
end    neGbcd; 

/*    eqSbcd    logically   compares    two    bed    numbers       */ 
/*    taken    from    the    stack   returns    a    value    of    one*/ 
/*    if    the    numbers    are    equal,    a    zero     if    not.       */ 
/*total    number    of    bytes    generated    =    66  */ 
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eqGbcd:    proc(a); 

dc  1    a    addr ; 

call    sten(21h. lah, llh, 36h, 80h, 2dh, 36h, 00h,21h, 19h) ; 

cal  1    gteu(7eh,0(16h,GSh,0d2h,  low(a+3eh)  ,hiffh(a+3eh)  ,  4eh,  06h,  00h,  2eh)  ; 

call    sten(03h,09h.7eh,211i,  19h,  llh.Seh,  16h,  O0h,  2eh)  ; 

call    sten(  19h,  19h.  4fli,  7eh,  9  Ih,  0c2h.  low(a+31h)  ,  hiffli(  a+31h)  ,21h,  lah)  ; 

cal  1    gten(  1  Ih,  36h,  0  Ih,  2dh,  34h,  0c3h,  low(a+8h)  ,high(a+8h)  ,21h,  lah)  ; 

cal  1    gten(  1  Ih,  36h,  00h,  2dh,  7eh,  0c6h,  03h,  77h,  0c3h,  low(a  +  31i)  )  ; 

call    geiiGiiveChighCa+Sh)  .  2ch,  4eh,  06h.  OOh)  ; 

call    genera te( 0c5h) ; 
end    eqObcd; 

/   ifs  ^  ^  if*  ^  ^  f^  J^  tf*  ^  *^  ^  Jf*  ^  it*  'V*  *V*  '^  ^  *i*  *V'  *^  *f*  ^  ^  «i*  *(*  if*  rf*  *f*  *f*  'V'  «^  ^  ^  ^V*  *f*  / 

/*    geGbcd     logically   compares    two    bed    */ 
/*    numbers     taken    from    the    stack   sftid    */ 
/*    returns    a    value    of    one     if    the     1st    */ 
/*    number     is    greater    or    equal    to     the    */' 
/*    second    number,     bytes    genera  ted=324*/' 

geSbcds  proc(a); 

del  a  addr; 

call    gten(0c3h,  low(a+0ech)  ,  high(  a+0ech)  ,21h,  leh,01h, 

36h,01h,2eh,  Ich)  ; 

cal  1    gten(7eh,0fli,Qd2h,  low(a+S0h)  ,high(a+80h)  ,2eh,  19h,  7eh,  2ch,  96h)  ; 

call    gten(0c2h,  low(a+67h)  ,high(a+67h)  ,21h,  leh,  0  Ih,  7eh,  0d6h, 

08h,0d2h)  ; 

call    gteu(  low(a  +  721i)  ,high(a+72h)  ,  4eh,  06h,  OGh,  2eh,  08h,  09h,  7eh,  21h)  ; 

call    sten( leh,01h,5ah, 16h,0Oh,2eh, 10h, 19h,4fh,7eh) ; 

call    gten(91h,0c2h, low(a+3dh) ,high(a+3dh) .21h, leh,01h,34h. 

0c3h,  low(a+17h>)  ; 

call    gten(high(a+17h)  ,21h,  leh.  0  Ih,  4eh.  06h,  O0h,  2eh,  O8h,09h)  ; 
call    gten(7eh,21h, leh,01h,5eh, 16h.00h,2eh, 10h, 19h) ; 

call    gten(4fh,7eh,5fh,79h,93h,0d2h, low(a+5dh) ,high(a+5dh) ,21h, Idh) ; 

call    gten(01h.36h,01h,21h, leh, 01h,7eh,Oc6h, 08h, 77h) ; 

call    gten(0c3h,  low(a-i-17h)  ,high(a+17h)  ,  2dh,  7eh,  2ch,  96h,  0d2h, 

low(  a+72h)  ,  high(  a+72h)  )  ; 

call    gten(2eh, Idh, 36h, 9 Ih, 2eh, leh, 7eh, 0d6h, 08h, 0c2h) ; 

call    gten(  low(a+0ebh)  ,  high(a+Oebh)  ,  2dh,  36h,  0  Ih,  0c3h,  low(a  +  Oebh)  , 

high(a  +  Oebh)  ,2eh,  19h)  ; 
call    steu(7eh,2ch,96h.0c2h,  low(a+0d6h)  ,  hlgh(  a+0d6h)  ,21h,  leh,01h,7eh)  ; 

cal 1    gten(0d6h,O8h,0d2h, low(a+OeOh) , high( a+OeOh) , 4eh»06h, OGh, 

2eh,08h)  ; 

call    gten(09h.7eh,21h, leh,01h,5eh, 16h,O0h,2eh, 10h) ; 

call  gten(  19h,  4f  h,  7eh,  9  Ih,  0c2h,  low(  a+Oaeh)  ,  high(  a+0aeh)  ,21h, 

leh,01h)  ; 

call  gten(34h,0c3h,  lov,(a+88h)  ,high(a+SOh)  ,21h,  leh,  01h,  4eh,  06h,  00h)  ; 

call  gten(2eh,08h,O9h,7eh,21h, leh,01h,5eh, 16h,00h) ; 

call    gten(2eh,  10h,  19h,  4f  h,  7eh,  9  Ih,  0d2h,  low(a  +  0cch)  ,  high(  a+0cch)  , 

21h)  ; 

call    gten( Idh, 01h, 36h,01h.21h, leh,01h,7eh, 0c6h, 08h) ; 

call    gten(77h,0c3h, low(a+88h) ,hish(a  +  88h) , 7eh, 2dh,  96h, 0d2h, 

low(  a+0e0h)  ,  high(  a+0e0h)  )  ; 

call    gten(2eh, Idh, 36h, 0 Ih, 2eh, leh,7eh, 0d6h, 08h, 0c2h) ; 
call    sten( low(a+0ebh) , high( a+0ebh) , 2dh, 36h, 0 Ih, 0c9h, 2 Ih, ldh,01h,36h) ; 

call    gten(00h,2eh, Ibh, 36h, OOh, 2ch, 36h, O0h, 2eh, 08h) ; 

call    gten(7eh,0e6h,79h,2eh, 19h,77h,2eh, 10h, 7eh, 0e6h) ; 

call    gten(79h,2eh, lah, 77h, 0afh, 0d6h, 80h, 9f h, 2eh, 08h) ; 

call    gten(0a6h,0fh,0d2h, low(a+117h) , high(  a+ 1 17h) .2eh, lbh,36h,01h, 

0a fh) : 

call    sten(0d6h,8Oh,9fh,2eh, 10h, 0a6h, 0f h,0d2h, low(a+126h) , 

high(a+126h))  ; 

call    gten(2eh. Ich, 36h, 01h, 2eh, Ibh, 7eh, 2ch, 0a6h, 0fh) ; 

cal  1    sten(0d2h,  low(a+135h)  ,  high(  a+ 135h)  ,0cdh,  low(a+3h)  ,high(a+3h)  , 

0c3h,  low(a+13dh)  ,  high(  a+ 13dh)  ,7eh)  ; 
call    gten(0fh,Od2h,  low(a+13dh)  ,  high(  a+ 13dh)  , 'Jch,  36h,  0  Ih,  21h,  ldh,01h)  ; 

call    genera te(  4eh) ; 

call    genera te( 06h) ; 

call    genera te( OOh) ; 

call    genera te( Ocoh) ; 
end    geSbcd? 
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y^  HT  i  teOs  ti- ing  calls  the  routine  that  */ 
/^  prints  the  characters  followed  by  the  */ 
/*  opcode,  total  no.  bytes  gen  =  61       */ 

writeOstrng:  proc ; 

dc  1  a  addr ; 

a  =  cspaddr( 63) ; 

call    gtan(0c3h,  low(a+2eh)  ,  hish(  a+2eh)  ,  21h,  03h,  01h,  71h,  2ch,  73h,  231i) 

call    s-ten(72h,0c3h,05h,00h,Oc9h,2Ih,Och,Olh,71h,0eh)  ; 

call    sten(02h.5eh,  16h,  OOh,  Ocdh,  low(a-12>  ,hi£rh(a-12)  ,  2  Ih,  3f  h,  01h)  ; 

call    sten(34h,3eh.4fh.96h,0d2h.  low(a+2dh)  .  higrh(  a+2dh)  ,0eh,02h,  leh) 

call    sten(Odh,  1  6h,  0?h,  Ocdh,  lov/(a-12)  ,hish(a-!2)  ,0eh,02h,  leh.Oah)  ; 

call    g:ten(  16h,  O0h,  Ocdh,  low(a-12)  ,high(a-12)  ,21h,  3fh,  01h,  36h,00h)  ; 

call    genera te ( 0c9h) ; 
end    writeSstrng; 


/*  converts  in  t  removes  the  first  two  */ 
/*  bytes  from  the  stack  changes  them  to*/ 
/^>  a  bed  number  and  returns  8  bytes  to  */ 
/*    the    stack,     total    bytes    =    383  */ 

/***;r:^*****  **********;?:********  ******:?;***/ 
convertSint;    proc (a); 

dc  1    a    addr ; 

call    gten(21h. I7h, Olh, 36h, Olh, 3ch, 07h, 21h, 17h,01h) ; 

call    gten(96h,0dah.  low(a+ldh)  ,high(a+ldh)  .  4eh,  06h,  OOh,  2eh,  0ah,  09h)  ; 

cal 1    gten(36h,00h,21h, 17h, 0 Ih. 34h, 0c2h, low(a+5h) ,high(a+5h) ,36h) ; 

call    gten(0Oh,3eh,O4h,21h, 17h, Olh, 96h, Odah, low(a+37h) ,high(a+37h) ) ; 

call    gten(4eh,06h.00h,2eh, 12h. 09h, 36h, OOh, 2 Ih, 17h) ; 

call    gten(01h,34h.Oc2h, low(a+lfh) ,high(a+lfh) , 2ch, 38h, OOh, 3eh,0f fh) 

call    gten(06h,7fh.2eh,08h,96h.2ch,4fh,78h,9eh.0d2h) ; 

call    gten(  low(a+59h)  .high(a+59h)  ,2eh,  18h.  36h,  Olh,  Oaf  h,  2eh,  08h,  96h)  ; 

call    gten(2ch,4fh,3eh,00h,9eh,2dh,71h,23h,77h,2eh) ; 

call    gtenC lah,36h. lOh, 23h, 36h, 27h, 2eh, 19h.36h,01h) ; 

call    gteu(2eh,0ah,36h,45h,21h, 19h, Olh, 7eh, Ofh, 0d2h) ; 

call    sten(  low(a+0cfh)  ,  high(  a+Oc  fh)  ,  2eh,  08h,  7ch,  2ch,  46h.  2eh,  lah,96h) 

cal  1    gten(2ch,4fh,78h,9eh,0dah,  low(a  +  85h)  ,high(a+86h)  ,2eL,  19h,36h)  ; 

cal 1  gten(00h,Oc3h, low(a+68h) ,hish(a+68h) , leh, Oah, 16h,eOh,21h, lah) ; 
cal 1  sten(Olh,4eh,2ch,46h,0c3h, low(a+OcOh) , high( a+OcOh) , 7ah, 2f h, 57h) 

call  gten(7bh,2fh,5fh, 13h, 21h, OOh, O0h,3eh, Ilh,0e5h) ; 

call  gten(  19h,0d2h, low(a+0a5h) , high(  a+0a5h) , 0e3h,Oe Ih.Of 5h, 79h, 

17h,4fh) ; 

call  gten(78h, 17h.47h.7dh, 17h,6fh,7ch, 17h, 67h, Of Ih) ; 

call    gten(3dh,0c2h. low(a+9fh) ,high(a+9fh) ,0b7h.7ch, lfh,57h,7dh. Ifh) 

call    gten(5fh.0c9h.0cdh. low(a+93h) ,high(a+93h) ,21h, lah, 0 Ih, 7 Ih, 23h) 

call    gten(70h,2eh,0ah,35h,0c3h, low(a+68h) ,high(a+68h) ,2dh, 7eh, Ofh) ; 
call    gten(0d2h,  low<a+Odbh)  ,  high(  a+Odbh)  ,  2eh,  Oah,  7eh,  0c6h,  80h,77h,2eh) 

call    gten( 17h, 36h, OOh, Oaf h, 21h. lah, 0 Ih, 96h, 2ch, 4f h) ; 
call    gten(3eh,00h,9eh,0d2h,  low(a+13bh)  , high(  a+ 13bh) ,2eh, 17h.4eh,06h) 

call    gten(00h.2eh. 12h. 09h, Oebh. 2 Ih. Oeah. 03h, 73h. 2ch) ; 

cal 1    gten(72h,21h, lah, 0 Ih, 5eh, 2ch, 56h, 2eh, 08h, 4eh) ; 

call  gten(2ch,46h,0cdh,  low(  a+93h) ,high(a+93h)  . 2ah, Oeah, 03h,71h, 21h) 

call  gten( 17h, 0 Ih, 34h, 2 Ih, lah, 0 Ih, 5eh, 2ch, 56h, 2eh) ; 

call    gten(08h,4eh,2ch,46h,0cdh, low(a+93h) ,high(a+93h) , 21h, 08h, Olh) ; 

call    gten(73h,23h,72h, leh, Oah, 16h,O0h,21h, lah, Olh) ; 

call    gten(4eh,2ch,46h,0cdh, low(a+93h) ,high(a+93h) ,21h, lah, Olh, 7 Ih) ; 
cal 1    gten(23h,70h,0c3h, low(a  +  Odfh)  , high(  a+0dfh) , Olh, 07h, OOh, 2eh, Oah) 

call    gten(09h,0ebli,21h,  12h,  0  Ih,  7eh,  87h,  87h,  87h,  87h)  ; 

call    sten(Od5h,4fh,0c5h,23h.7eh,Odlh,83h,0elh,77h,Olh) ; 

call    gten(O6h,OOh,21h,Oah,01h,09h,Oe5h,Olh,02h,OOh) ; 

call    sten(21h, 12h, 0 Ih, 09h, 7eh, 87h, 87h, 87h, 87h, llh) ; 

call    gten(03h,OOh,21h, 12h,01h, 19h, 4f h,7eh, 81h, Oe Ih) ; 

call    gten(77h,Olh,05h,OOh,21h,Oah,Olh,O9h,Oe5h.Olh) ; 

call    gten(04h,00h,21h, 12h, 0 Ih, 09h, 7eh, 87h, 87h, 87h) ; 

call    genera te( 87h) ; 

call    genera te ( Oe Ih) ; 

call    genera te( 77h) ; 
e  nd    c  o  nve  r  t  S  i  n  t ; 
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/*  couvertCbcd    pops     the    next    ei^ht    bytes    */ 

/*  from    the    stack,    converts    the    bed    num      */ 

/^  to    an    integer    number    and    returns     it    to*/ 

/*  the    stack,     bytes    generated    =    313  */ 

convertObcd:     proc(a); 
dc  I    a    addr ; 
cal 1    gten(0c3h. low(a+lfh) ,hlgh(a+!fh) .21h, 15h, 01h,71h, 2ch, 73h, 23h) 
call    slen(72h,0c3h,O5h.00h,0c9h.21h, 17h. 0 Ih, 71h, 23h) ; 
cal 1    sten(70h,0eh,O9h,2dh,5eh,2ch,56h,Ocdh, low(a+3h) ,high(a+3h) ) ; 
call    gten(0c9h,21h, 12h, 0 Ih, 36h, O0h, 2eh, lOh,35h,O0h) ; 
call    sten(23h,36h,OOh,2eh,08h,7eh,Oe6h,7fh,4fh,3eh) ; 
call    gten(45h,91h,0d2h,  low(  a  +  4dh)  ,high(a+4dh)  ,0c  3h,  low(a+44h)  , 

high(a+44h) ,45h,52h)  ; 
call    gten(52h,4fh,52h,20h,49h,4fh,20h,24h,01h,3ah) ; 
call    gten(02h,0cdh,  low(a+Ofh)  ,high(a  +  0fh)  ,0c3h,  low(a+139h)  , 

high(a+139h) ,7eh,0e6h,80h) ; 
call    gten(0d6h.80h,0c2h,  low(a  +  59h)  ,high(a+59h)  ,2eh,  12h,36h,  01h,2eh) 
call    gten(O8h,7eh,0e6h,7fh,Od6h,40h.2eh. 13h,77h,3eh) ; 
call    gten(7fh,96h,0d2h,  low(a+6bh)  ,hish(a+6bh)  ,  36h.  OOh,  2ch,  36h,  07h) 
call    gten(0afh,21h, 13h, 0 Ih. 96h, 0d2h, low(a+103h) , high( a+ 103h) , 

2ch,4eh)  ; 
cal 1    gten(O6h,00h,2eh,08h,09h,7eh, leh, 04h, 0b7h, Ifh) ; 
call    gten( ldh,0c2h, low(a+a0h) ,high(a+80h) . 06h, O0h,4fh, 21h, 18h,01h) 
call    gten(71h,2ch,70h, leh,0ah, 16h,00h,21h, 10h,01h) ; 
call    gten(4eh,2ch,46h,0c3h, low(a+0bfh) , high(  a+Obfh) ,79h,93h, 

78h,9ah) ; 
call    gteu(0f2h, low(a+0a8h) , highC a+0a8h) , 60h, 69h, 0ebh, 44h, 4dh, 

21h,0Oh) ; 
call    gten(O0h.0ebh,78h,9blh,0c8h.0ebh.78h,  lfh,47h,79h)  ; 
call    gten( I f h, 4f h, 0d2h, low(a+Obah) , high( a+Obah) , 19h, 0ebh. 29h, 

0c3h.  low(a+0ach)  )  ; 
cal  1    gten(high(a  +  0ach)  ,0cdh,  low(a+9ch)  ,high(a+9ch)  ,21h,  18h,01h, 

4eh,2ch,46h)  ; 
call    gten(0ebh.09h,22h, lOh,Olh.21h,0f9h,0Oh,35h,0afh) ; 
call    gten(96h,0d2h, low(a+6eh) ,high(a+6eh) , leh,0ah, 16h,00h.21h, 10h) 
cal  1    gten(01h.4eh,2ch,46h,0cdh,  low(a+9ch)  ,high(  a+9ch)  ,0d5h, 

21h, 14h) ; 
call    gten(01h,4eh,06h,Oeh,2eh,08h,09h,7eh,0e6h,Ofh) ; 
call    gten(O6h,0Oh.4fh.0dlh,69h,6Oh. 19h,22h, 10h,Olh) ; 
call    gten(21h, 14h. 0 Ih, 35h, 2dh, 35h, Oc3h, low(a+6eh) ,high(a+6eh) ,3eh) 
call    gten(0f fh,06h,7fh,2eh, 10h, 96h, 2ch, 4f h, 78h, 9eh) ; 
call    gten(0d2h.  low(a+124h)  ,  high(  a+ 124h)  ,0c3h,  low(a+lleh)  , 

high( a+ 1 leh) , 45h. 52h, 52h, 4f h) ; 
call    gten(52h,2Oh,49h,4fh,20h,24h,01h,  low(a+114h) , high(  a+ 1 14h)  , 

0cdh)  ; 
call    gten( low(a+0fh) ,high(a+0fh) ,21h, 12h, 01h, 7eh,0fh, 0d2h, 

low(a+139h)  ,high(a+139h)  )  ; 
call    gten(0afh,2eh, lOh, 96h, 2ch, 4f h, 3eh, OOh, 9eh.  2dh)  ; 
call    genera te(  71h) 
call    genera  te(  23h) 
call    genera te ( 77h) 
end    convertGbcd; 

/*  dump  generates  code  for  a  carriage  */ 
/*  return  and  line  feed  character  to  */ 
/*    the    screen    to    start    a    new    line.  */ 

/*       total    number    of    bytes    genera  ted=38*/' 

dump:    proc ; 

dc  1  a    addr ; 

a    =  cspaddrC  64)  ; 

cal 1  gten(0c3h, low(a+0fh) ,hlgh(a+0fh) , 2 Ih, 08h, Olh, 71h, 2ch, 73h, 23h) 

cal  1  gten(72h,Oc3h,O5h,0Oh,Oc9h,0eh,02h,  leh,Odh,  I61i)  ; 

call  gtenC  OOh,  Ocdh,  low(  a+3h)  ,  high(  a+3h)  ,  Oeh,  02h,  leh,  0ah,  16h,  OOh)  ; 

cal  1  genSf  ive(0cdh,  low(a+3h)  ,high(a+3h)  ,21h,3fh)  ; 

call  genera te( 0 Ih) ; 

call  genera  te  (  36h)  ; 

call  genera te( OOh) ; 
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end    duap; 

/***  procedures       called       by      case       stmt    ***/ 

setOflags:     proc  ; 

del     i    byte; 

do     i= 1     to    65 ; 

cspc ( i ) =     true ; 

end; 
end    setGflags; 

endp 1 :     proc  ; 

pass  1=    false ; 

pass2=     true; 

call    se  tGf lags ; 

call    se tupScomSf i le ; 

call    rewindSp inSf i le ; 

call    openSpinSf i le ; 

codestrt    =    varstrt    +    varcount ; 

progSsize    =    codestrt    +    codecount; 

pinptr    =    pinrecsize; 

spSmax    =    max    -    2; 

call    generateOlh)  ;  /*    Ixi    sp    */ 

call    genera te( low( spGmax) ) ;  /*    max   stack   ptr    */ 

call    genera  te  ( liigh(  spSinax)  )  ; 

call    genera te( 0c3h) ;  /*    Jmp    to    code    area    */ 

call    genera te (  low(  codes tr t ))  ; 

call    genera te( high(  codes tr t) )  ; 

do    loop= 1    to    (varcount    +    58);  /*    initialize    work  area    */ 

call    genera te ( OOh) ; 

end ; 
e  nd    e  nd  pi; 

endprog:    proc; 

pass2    =    fa  Ise ; 
call    genera te(  0fbh)  ; 
call    genera  te  (  76h.)  ; 
call    genera te( 76h) ; 
call    de  le teSpinSf ile ; 
call    wr i teScomSf i le ; 
call    c loseScomSf i le ; 
if    errcount    =    0    then   do; 

call    print(.'end    of    compilation,    no    program   errors. 3'); 

call    printchar(0dh) ;  /*   cr    «/ 

call    printchar(0ah) ;  /*    If    */ 

e  nd  ; 
else    call    print(.'    compilation    terminated    due    to    errorCs).    S'); 
call    pr intchar ( Odh) ; 
call    pr intchar( 0ah) ; 
go  to    boo  t ; 
end    endprog; 

secSpass?  proc(a); 

del  a  addr; 

call  genera te( 0cdh) ;       /*  call  */ 

call  genera  te(  low(  a)  )  ; 

call    genera te(high(a) ) ; 
end    secSpass ; 

lbl2:  proc; 

del  (  lb  Iniunber  ,  lb  laddr  ,  n  based  Ibladdr)  addr; 

Iblnumber  =  ge tSnextSaddr ; 

Ibladdr  =  .memory  +  (.2^    Iblnumber); 
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/* 

ei    */ 

/* 

hit    «/ 

/* 

hit    */ 

n  =  codecount; 
end  lbl2; 


Id  ib3 :  proc ; 

del  i  byte,  a  addr; 

do  i=  1  to  4; 

a  =  ge tOnextSaddr ; 

call  genSf  ive( ©eh,  low(  a) , 06h, highi a)  , 0c Ih) 

end ; 
end  IdibS; 


ldii4:  proc; 

del  a  addr; 

a  =  ge tOnextSaddr; 

call  genOf  ive(  Oeh,  low(  a)  ,  06h,high(  a)  ,Oclh)  ; 
end  ldii4; 


cnvb9 •    proc ; 

dc  1  a  addr ; 

call    senerate(0c3h) ;  /*    Jmp    */ 

call    genera te(  low(  cspaddr(9)    +    358)); 

call    genera te( high( cspaddr( 9)    +    358)); 

call    popCsvSaddr( 106h) ;  /«    7    bytes    ^y 

call    popGbcd( 108h) ;  /*   23   bytes    */ 

a    =    cspaddr(9)    +    30; 

/*   313   bytes    */ 
/*   7    bytes    «/ 

call    pushSsvSaddr( 106h) ;  /*    7    bytes    */ 

call    generate(0c9h) ;  /*   ret    */ 

call    genera  te(  0cdli)  ;  /*   call    */ 

call    genera te(  low(  cspaddr( 9) )) ; 

call    genera te( high( cspaddr( 9) )) ; 
end    cnvb9; 


call    conver tSbcd( a) 
call    pushSint( 1 lOh) 


\ 


cnvil0:    proc; 

dc  1    a    addr ; 

call    genera te ( 0c3h) ;  /*    Jmp    */ 

call    genera te( low( cspaddr( 10)    +   428)); 

call    genera te( high( cspaddr( 10)    +    428)) 

call    popSsvSaddr( 106h) ; 

cal  1    popSintC  1081i)  ; 

a    =    cspaddrC  10)    +    14; 

call    CO n ve rt$int(a)  ; 

call    push$bcd( 10ah) ; 

call    pushSsvSaddr( 106h) ; 

call    genera  te(  0c9h)  ; 

call    genera te( 0c dh) ; 

call    genera te(  low(  cspaddr(  10) ))  ; 

call    genera te ( high( cspaddrC 10) ) ) 
end    cnvil0; 


1 i  ta 12:    proc  ; 

dc  1     taddr    addr ; 

taddr    =    ge tSnextSaddr    +    varstrt; 

call    generate(01h) ;  /*    Ixi    b    */ 

call    genera te(  low(  taddr) )  ; 

call    genera te( highC taddr) ) ; 

call    genera  te(0c5h)  ;  /*    push   b    */ 

end    lital2; 


addbl3:    proc; 
end    addbl3; 

addil4:    proc; 
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/•<c 

7    bytes    */ 

/* 

7   bytes    */ 

/* 

383   bytes    »/ 

/* 

23    bytes    */ 

/* 

7   bytes    */ 

/■*    ret    */ 

/*    call    */ 

L 


call    senerate(Oc Ih) ;  /*   pop    b    */ 

call    genera te( 0e Ih) ;  /^    pop    h   */ 

call    seaerate(09h) ;  /*    dad    b    */ 

call    genera te( Oe5h) ;  /*    push   h   */ 
end    addil4; 

subbl5:    proc; 
end    subbl5; 


sub  i  16  '■    proc  ; 

call    genera te( 0c Ih) ;  /*    pop    b    */ 

call    genera te(Odlh) ;  /*    pop    d    */ 

call    genera  te(  791i)  ;  /*    mova    c    */ 

call    g8nerate(93h) ;  /*    sub    e    */ 

call    genera te( 4bh) ;  /*    move    e    */ 

call    genera te( 78h) ;  /*    mova    b    */ 

call    genera te(9ah) ;  /*    sbb    b    */ 

call    genera te(47h) ;  /*    movb    a    */ 

call    genera te(0c5h) ;  /*    push  b    «/ 

e  nd    s  ub  i  1 6  ; 


mulblT:  proc; 
end  mulbl7; 


mul i 18:  proc ; 

dc  1  a   addr ; 

call    genera te ( 0e3h) ;  /*    Jmp    */ 

call    genera te(  low(  cspaddr(  18)     +    55)); 

call    genera te( high( cspaddrC 18)    +    55)); 

call    popGsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr( 18)     +    7; 

call    multSint(a);  /*40   bytes    */ 

call    pushS9vSaddr( 106h) ;  /*    7    bytes    */ 

call    generate(0c9h) ;  /«    rtn    */ 

call    generate(0cdh) ;  /*    call    «/ 

call    genera te ( cspaddr( 18) ) ; 

call    genera te( cspaddr( 18) ) ; 
e  nd    mu 1118; 


divbl95    proc; 
end    divbl9; 


divi20:     proc; 

dc  1    a      addr ; 

call    genera te ( 0c3h) ;  /«    jmp    «/ 

call    genera te(  low(  cspaddr(  20)     +    69)); 

call    genera te( high( cspaddr( 20)    +    69)); 

call    popSsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(20)     +    7; 

call    divSint(a);  /*    54    bytes    «/ 

call    pushSsv«addr( 106h) ;  /*    7    bytes    */ 

call    generate( 0c9h) ;  /*    rtn   */ 

call    generate(0cdh) ;  /*    call    */ 

call    genera te( cspaddr( 20) ) ; 

call    genera te( cspaddr( 20) ) ; 
end    divi20; 


lssb21:    proc; 
end    lssb21; 
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Iss 122:    proc  ; 

dc 1    a    addr ; 

call    genera te(0c3h)  ;  /«    Jmp    */ 

call    genera te(  low( cspaddr(  22)     +    38)); 

call    senerate(high(cspaddr(22)     +    38)); 

call    popSsvSaddr( 106h) ;  /*      7    bytes    */ 

a    =    cspaddr(22)     +    7; 

call     ItSint(a);  /:K    23    bytes    */ 

call    pushSsvCaddr(  IO6I1)  ;  /«    7    bytes    */ 

call    genera te(0c9h) ;  /*    ret    */ 

call    generate(0cdh) ;  /*    call    */ 

call    genera te (  low(  cspaddr(  22) ))  ; 

call    generate( high( cspaddr ( 22) ) ) ; 

end    Iss 122; 


leqb23:    proc; 
end    leqb23; 


leqi24:    proc; 

dc  1    a    addr ; 

call    generate(0c3h) ;  /*    Jmp    */ 

call    genera  te(  lov/(  cspaddr(  24)    +    38)); 

call    genera te( high( cspaddr ( 24)     +    33)); 

call    popSsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(24)     +    7; 

call     leGlnt(a);  /*    23    bytes    */ 

call    pushSsvSaddr( 106h) ;  /«    7   bytes    */ 

call    generate(0c9h) ;  /*    ret    */ 

call    generate(0cdh) ;  /*    call    */ 

call    genera te (  low( cspaddr  (  24) ))  ; 

call    generate(  hlgli(  cspaddr(  24)  )  )  ; 

end     leqi24; 

eqlb25:    proc; 

dc  1    a    addr; 

call    generate(0c3h) ;  /*    Jmp    */ 

call    genera te( low( cspaddr( 25)     +    81)); 

call    genera  te(  hlgli(  cspaddrC  25)    +    81)); 

call    popSsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(25)    +    7; 

call    eqSbcd(a);  /*    66    bytes    */ 

call    pushSsvSaddr( 106h) ;  /«    7    bytes    */ 

call    generate(0c9h) ;  /*    ret    */ 

call    genera te ( 0cdh) ;  /*    call    */ 

call    genera te(  low( cspaddr( 25) )) ; 

call    generate( high( cspaddr (25))); 

end    eqlb25; 


eqli26:    proc; 

dc 1    a    addr; 

call    generate(0c3h) ;  /*    jmp    */ 

call    genera te(  low( cspaddr( 26)    +    39)); 

call    genera te( high( cspaddr( 26)     +    39)); 

call    popSsv«addr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(26)     +    7; 

call    eqSlnt(a);  /*    24    bytes    */ 

call    pushSsv«addr( 106h) ;  /*      7    bytes    */ 

call    genera te( 0c9h) ;  /*    ret    */ 

call    genera te(0cdh) ;  /*    call    */ 

call    genera te( low( cspaddr ( 26) )) ; 

call    genera  te( high( cspaddr( 26) ) )  ; 

end    eqli26; 


eqls27:  proc; 
end  eqls27; 
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/* 

24 

bytes 

*/ 

/* 

7 

bytes 

*/ 

/* 

re  1 

*/ 

/*    call    */ 

i 


L 


ne  qb28:     proc ; 

dc  1    a    addr ; 

call    genera  te(  0c3h)  ;  /Xs    Jmp    */ 

call    genera  te(  low(  cspaddr(  28)     +    82)); 

call    genera te( high( cspaddr(  28)     +    32)); 

call    popGsvSaddr( 106h) ;  /*    7    bytes    ^Z 

a    =    cspaddr(28)    +    7; 

call    neObcdCa);  /*    67    bytes    t./ 

call    pushiJsvSaddrC  1061i)  ;  /^^    7    bytes    */ 

call    genera te(0c9h) ;  /*    ret    */ 

call    generate(0cdh) :  /*    call    «/ 

call    genera te (  low( cspaddr(  28) ))  ; 

call    genera  te( high(  cspaddr  (  28)  )  )  ; 

end    neqb28; 


neqi29:    proc; 

del    a    addr; 

call    generate(0c3h) ;  /*    jmp    */ 

call    generate( low(cspaddr(29)     +    39)); 

call    genera te( high( cspaddr( 29)     +    39)); 

call    popGsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(29)    +    7; 

call    neSint(a); 

call    pushSsvSaddr(  106h) 

call    genera te( 0c9h) ; 

call    genera te ( Ocdh) ; 

call    genera te (  low(  cspaddr(  29)  ))  ; 

call    genera te( high( cspaddr(  29) ) ) 
end    neqi29; 


neqs30:    proc; 
end    neqs30; 

geqbSl:    proc; 
end    geqb31; 


geqi32:    proc; 

dc  1    a    addr ; 

call    generate(©c3h) ;  /*    Jmp    */ 

call    genera te( low(cspaddr(  32)     +    38)); 

call    generate(high(cspaddr(32)     +    38)); 

call    popSsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(32)     +    7; 

call    geSint(a);  /*   23    bytes    */ 

call    pushSsvSaddr( 106h) ;  /*    7    bytes    «/ 

call    generate(0c9h) ;  /*    ret    */ 

call    generate(0cdh) ;  /*    call    */ 

call    generate(  low(cspaddr(  32) ) )  ; 

call    generate( high( cspaddr(  32) ) ) ; 

end    geqi32; 


grtb33:  proc; 
end  grtb33; 


grt  134: proc ; 

dc  1  a  addr ; 

call  genera te ( 0c3h) ;        /*  jmp  */ 

call  genera te(  low(  cspaddrC 34)  +  38)); 

call  genera te( high( cspaddr(  34)  +  38)); 

call  popSsvSaddrC 106h) ;     /*  7  bytes  */ 

a  =  cspaddr(34)  +  7; 

call  gtSint(a);  /*  23  bytes  */ 
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call  pushSsvSaddrC 106h) ;      /*  7  bytes  */ 

call  g^enera  te(0c9h)  ;       /«  ret  */ 

call  genera te ( 0cdh) ;  /*  call  «/ 

ca 1 1  genera  te( low(  cspaddr(  34) ) )  ; 

call  generate( highi cspaddr( 34) ) ) ; 


end  grti34; 


negb35 :  proc ; 

call  genera te  (  Gc Ih) 
call  genera te(  3ah) 
call  genera te ( 80h) 
call  genera te ( 81h) 
call  genera te( 4fh) 
call  genera te(0c5h) 

end  negb35; 


/*  pop  b  */ 
/*  Ida  */ 
/*  10000000  -S/ 
/*  add  c  */ 
/*  move  a  */ 
/*  push  b  */ 


negi36 :  proc ; 

call  genera te ( 0c Ih 
call  genera te( Oaf h 
call  genera te( 9 Ih) 
call  genera te ( 4fh) 
call  genera te(  3eh) 
call  genera te ( OOh) 
call  genera te ( 98h) 
call  genera te( 47h) 
call  genera te(  0c5h) 

end  negi36; 


/*  pop  b  */ 

/*  xra  a  */ 
/*  sub  c  */ 
/*  move  a  */ 
/*  mvi  a  «/ 
/*  ooh  */ 
/*  sbc  b  */ 
/*  movb  a  */ 
/«  push  b  */ 


comb37:  proc; 

call  genera te(  0c3h)  ; 

call  genera te ( low(  cspaddr 

call  genera te( high( cspadd 

call  popGsvGaddr( lOeh) ; 

call  popSbcd( 106h) ;     /* 

call  complSbcd(  106h)  ;   /* 

call  pushSbcdC 106h) ;    /* 

call  pushSsvGaddr( 10eh) ; 

call  genera te( 0c9h) ; 

call  genera te ( Ocdh) ; 

call  genera  te(  low(  cspaddr 

call  genera te(high( cspadd 

end    comb37; 


/*    J rap    */ 
(37)    +    104)); 
r(37)    +    104)) ; 
/*    7    bytes    «/ 
23   bytes    */ 
43    bytes    */ 
23    bytes    */ 
/*   7   bytes    */ 
/*    re  t    */ 
/*    cal 1    */ 
(37))) ; 
r(37))) ; 


comi38:    pro 
call    ge 


call 
call 
call 
call 
call 
call 
call 
call 
call 


ge 


c  ; 

nera  te( 
nera  te( 
nera te( 
nera  te ( 
nera  te ( 
nera  te( 
nera  te ( 
nera  te ( 
nera  te ( 
nera  te ( 


0c Ih) ; 
79h)  ; 
0eeh)  ; 
0ffh) ; 
4f  h)  ; 
78h)  ; 
Oeeh)  ; 
0ffh) ; 
47h)  ; 
0c5h)  ; 


/* 

pop  b  */ 

/* 

mo  va  c  */ 

/* 

xri  */ 

/* 

11111111  */ 

/* 

mo  vc  a  */ 

/* 

mova  b  */ 

/* 

xri  */ 

/* 

11111111  */ 

/* 

mo  vb  a  */ 

/* 

push  b  */ 

end    com 138; 


not39:    proc; 

dc  1    a    addr ; 

call    generate(0c3h)  ;  /*   jmp    */• 

call    genera te( low(  cspaddr( 39)    +    34)); 
call    genera te( high( cspaddr( 39)     +    34)) 


call    popSsvSaddr( 106h) ; 
a    =    cspaddr(39)    +    7; 
call    notSbool(a); 
call    pushSsvSaddr( 106h) 
call    genera te(  0c9h)  ; 
call    genera te( Ocdh) ; 


/*    7    bytes    */ 

/xc    19    bytes    */ 
/*   7   bytes    */ 
/*    ret    */ 
/*    call    */ 
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call    genera te(  low(cspaddr(39) )) ! 
call    genera te( high(cspaddr(  39) ) ) 
end    not39; 


and40 :  proc; 

dc  1  a  addr ; 

call    generate(0c3h) ;  /%    Jmp    */ 

call    genera te(  low(  cspaddr(  40)     +    41)); 

call    genera te( high( cspaddr( 40)     +    41)); 

call    popGsvSaddr(  106h)  ;  /*    7    bytes    ^/ 

a    =    cspaddr(40)    +    7; 

call    andSbooKa);  /*    26    bytes    */ 

call    pushSsvSaddrC 106h) ;  /*   7    bytes    */ 

call    genera te(0c9h) ;  /*    ret    */ 

call    genera te ( 0cdh) ;  /*    call    */ 

call    genera te(  low(  cspaddr(  40) ))  ; 

call    generateC  high( cspaddr  (  40) ) )  ; 

end    and40; 


bor41:    proc; 

dc  1    a    addr ; 

call    genera te( 0c3h) ;  /*    jrap    */ 

call    genera  te  (  low(  cspaddr(  4  1)     +    41)); 

call    genera te ( high( cspaddrC 41 )     +    41)); 

call    popSsvSaddr( 106h) ;  /*    7    bytes    */ 

a    =    cspaddr(41)     +    7; 

call    orSbool(a);  /*    26    bytes    */ 

call    pushSsvSaddr( 106h) ;  /«   7   bytes    */ 

call    generate(0c9h) ;  /*    ret    */ 

call    generate(0cdh) ;  /*    call    */ 

call    genera te(  low(  cspaddr(  4 1 )))  ; 

call    generate( high( cspaddr  (  41) ) )  ; 

end    bor41; 


stob42:    proc; 

call  genera te(0c3h) ;  /*    Jmp    */ 

call  genera te(  low(  cspaddr(  42)    +    44)); 

call  genera te( high( cspaddr(  42)    +    44)); 

call  popSsv«addr( 106h) ;  /*    7    bytes    */ 

call  stoSbcd;  /*   21    bytes    */ 

call  svSstack(bcdSlen) ;  /*    8   bytes    */ 

call  pushSsvSaddr(  I06h)  ;  /*    7    bytes    •*■/ 

call  generate(0c9h) ;  /*    ret    */ 

call  generate(0cdh) ;  /*    call    */ 

call  genera te( low(  cspaddr(  42) ))  ; 

call  generateC  high( cspaddr  (  42) > )  ; 

end    stob42; 


s to  143:    proc; 

call    genera te ( 0e Ih) ;  /*    pop    h  */ 

call    genera te( 0c Ih) ;  /*    pop    b    */ 

call    genera te( 7 Ih) ;  /*    movm  c    */ 

call    generate(23h) ;  /*    inx   h  */ 

call    generate(70h) ;  /*    movm   b    */ 
call    svSstack( int len) ;    /*    2    bytes    */ 

end    s to  143; 


sto44:    proc; 

call    genera te(0e Ih) ;  /*    pop    h   ^/ 

call    genera te( 0c Ih) ;  /*  pop    b    */ 

call    generate( 71h) ;  /*  movm   c    */ 

call    genera te ( 3bh) ;  /*  dcx   sp    */ 

call    generate(3bh) ;  /*  dcx   sp    */ 

end    sto44; 


s  tdb45 : proc ; 
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call  genera te( 0c3h) ;      /*  jmp  */ 
call  genera te (  low(  cspaddr(  45)  +  36)); 
call  genera te( high( cspaddrC 45)  +  36)); 
call  popGsvGaddr(  106h)  ;       /:»  7  bytes  */ 
call  stoSbcd;  /*    21  bytes  */ 

call  pushGsvSaddr( 106h) ;     /^   7   bytes  */ 
call  genera te(0c9h) ;  /*    ret  */ 

call  genera te(0cdh) ;  /*  call  */ 

call  genera te (  low(  cspaddr(  45) )) ; 
call  genera  te ( high( cspaddr ( 45) ) )  ; 
end  stdb4o; 

o  td  i46 :    proc ; 

call    generate(Oe Ih) ;  /*  pop    h   */ 

call    genera te( Oc Ih) ;  /*    pop    b    */ 

call    genera te( 7 Ih) ;  /*  raovm   c    */ 

call    generate(23h) ;  /*  inx    h   */ 

call    generate(70h)  ;  /*  movin   b    */ 

end    stdi46; 


s  td47:    proc ; 

call    generate(0e Ih) ;  /*    pop    h   */ 

call    generate(0c Ih) ;  /*    pop    b    */ 

call    genera te(71h) ;  /*    movm   c    */ 

end    std47; 


cna 15 1 :    proc ; 

do  1    a    addr ; 

call    genera te(0c3h) ;  /*    Jmp    */ 

call    genera te (  low( cspaddr(  5 1 )    +    442)); 

call    genera te( high(  cspaddr(  5 1)    +    442)) 

call    popGsvSaddr( 106h) ; 

call    popS9v3addr(  1 Ibh)  ; 

call    popSint( 108h) ; 

a    =    cspaddr(51)     +    21; 

call  conver tS int  (  a)  ; 

call  pushSbcd( 10ah) ; 

call  pushSsvSaddr(  1 Ibh)  ; 

call  pushSsvSaddr(  106h) ; 

call  genera te( 0c9h)  ; 

call  genera te( 0cdh)  ; 

call  generateC low( cspaddr(  5 1) ) )  ; 

call  genera te(high( cspaddr(  5 1 )) ) 
end  cnaiSl; 


brl52:  proc; 

del  (  lb  1  , to t ,  Ibladdr , u  based  Ibladdr)  addr; 

Ibl  =  getSnextSaddr ; 

Ibladdr    =     .memory   +    (2    *    Ibl); 

tot    =    n    +    codestrt; 

call    generate(0c3h) ;  /*    jmp    */ 

call    generate(low<tot)); 

call  genera te( high(  to t) )  ; 
end  brl52; 


blc53:  proc; 

del  (  Ibl  , tot , Ibladdr, n 

Ibl  =  getSnextSaddr; 

Ibladdr  =  .memory  +  (2 

tot  =  n  +  codestrt; 

call  genera te( 0c Ih) ; 

call  genera  te  (  79h)  ; 

call  genera te(  0fh)  ; 

call  genera te( 0dah)  ; 

call  genera  te  (  low(  to  t ))  ; 

call  genera te( high(  to t) ) 
end  blc53; 


269 


/* 

7  bytes  */ 

/*  7 

bytes  */ 

/* 

7  bytes  «/ 

/* 

383  bytes  */ 

/* 

23  bytes  */ 

/« 

7  bytes  «/ 

/* 

7  bytes  */ 

/* 

re 

t 

*/ 

/« 

ca 

11 

*/ 

based  Ibladdr) 

addr; 

Nt 

Ibl)  ; 

/* 

pop  b  «/ 

/* 

mo  va  c  */ 

/* 

rrc  */ 

/* 

jc  */ 

cn2i54 
dc 
ca 
ca 
ca 
ca 
ca 
ca 
a 

ca 
ca 
ca 
ca 
ca 
ca 
ca 
ca 

e  nd  c  n2 


proc  ; 

a    addr; 
1    generate(0c3h)  ;  /*    jmp   */ 

1    genera te (  low( cspaddr(  34)     +    474)); 
1    genera te( hiffhC cspaddr( 54)    +    474)); 
1    popGsvGaddr(  106h) ; 
1    popSbcd( 1 Ibh) ;  /* 

i    popGintC  lOob.)  ; 

cspaddi-(54)    +    37; 
1    CO  n ve  rtSint(a) 
pushSbcd(  lOah) 


/*   7   bytes 
23    bytes    */ 
/*    7    bytes 


*/ 


:;:/ 


pushSbcd( llbh) 

pushGsvSaddr(  IO6I1) 

genera te( 0c9h) ; 

generate(0cdh)  ; 

genera  te(  low(  cspaddr(  54) ) ) ; 

genera  te(high( cspaddr(54))); 


/«  383  bytes  */ 
/*  23  bytes  */ 
/*  23  bytes  ■»/ 

/*  7  bytes  «/ 

/*  re  t  */ 

/*  call  */ 


154; 


lod55J  proc; 

call  genera teCOe Ih) 
call  genera  te  (  4eh) 
call  genera  te  (  06h) 
call  genera te  (  00h) 
call  genera te ( 0c5h) ; 

end    lod55; 


/*   pop   h  */ 
/*    move    m   */ 
/*    mvi    b    */ 
/*    0    */ 
/*    push   b    */ 


.     _, */ 

^a^L    lOdSbcd;  /*   21    bytes    */ 

call    pushSsvSaddr( 106h) ;         /*   7   bytes    %/ 
call    generate(0c9h) ;  /*    ret    */ 

call    generate(0cdh) ;  /*   call    */ 

call    genera  te (  lo w( cspaddr( 56) ) )  ; 
call    generate( high( cspaddr(56) ) ) ; 
lodb56 ; 


end    lodb56; 


lod 157:    proc ; 

call    genera te(0e Ih) 
call    genera te( 4eh) 
call    genera  te  (  23h) 
call    genera te(  46h) 
call    genera te ( 0c5h) 

end     lod 157; 


/*  pop  h  */ 
/*  move  m  15/ 
/*    inx    h   «/ 

/*    raovb    m   «/ 
/*    push   b    */ 


rdvb58:  proc; 
end  rdvb58; 

rdvi59:  proc; 
end  rdvi59; 

rdvs60t  proc; 
end  rdvs60; 


wrvb6 1 :  proc ; 

dc 1  a  addr ; 

call  generate(0c3h) ;      /*  jmp  */ 
call  genera te(  low(  cspaddr(  6 1 )  +  502)); 
call  genera te(high( cspaddr(  6 1)  +  502)); 
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/^ 

7  bytes  */ 

/* 

23  bytes  */ 

/* 

464  bytes  :*:/ 

/* 

7  bytes  */ 

/* 

ret  */ 

/* 

call  */ 

call  popSsvGaddr(  106h)  ; 
call  popSbcd( I08h) ; 
a  =  cspaddr(61)  +  38; 
call  pr int5bcd(  a)  ; 
call  pushSsvSaddr(  106h) ; 
call  genera te( 0c9h)  ; 
call  genera te ( 0cdh)  ; 
call  genera  te(  low(  cspaddr(  61)  ))  ; 
call  genera te( high( cspaddr( 6  1) ) ) 
end  v?rvb6  1 ; 


wrvi62:  proc ; 

dc  1  a  addr ; 

call  genera  te(0c31i)  ;      /*  Jmp  «/ 

call  genera te(  low(  cspaddr(  62)  +  592)); 

call  generate(high(cspaddr(62)  +  592)); 

call  popSsvSaddr(  106h) ;      /*  7  bytes  */ 

call  popSint( 108h) ;  /*  7  bytes  */ 

a  =  cspaddr(62)  +  14; 

call    pr intSint(a) ;  /*    570   bytes    */ 

call    pushSsvSaddr( 106h) ;  /*    7    bytes    */ 

call    genera  te(0c91i)  ;  /*    ret    */ 

call    generate(0cdh) ;  /*    call    */ 

call    genera  te(  low(  cspaddr(  62)  )  )  ; 

call    genera  te(  liigli(  cspaddr  (  62)  )  )  ; 

end    >n*vi62; 


^*rvs635    proc(n); 

del    (n,i,ch)    byte; 

i    =    0; 

do    whi  le     i    <     n; 

ch   =    ge tSnextSbyte ; 

call    genera te(0eh) ;  /*    movi    c    */ 

call    genera  te  (  ch)  ; 

call    generate(0cdh) ;  /*    call    */ 

call    genera te (  low(  cspaddr(  63) ))  ; 

call    generate( high(  cspaddr(63))); 

i    =     i    +    1; 
end ; 
end    wrvs63; 


dmp64:  proc; 

call  genera te(0c3h) ;         /*  jmp  */ 

call  genera te(  low(  cspaddr( 64)  +  39)); 

call  genera te( high( cspaddr( 64)  +  39)); 

call  dump;  /*  38  bytes  «/ 

call  genera te(0c9h) ;         /*  ret  */ 

call  genera te(0cdh) ;  /*  call  */ 

ca  1 1  genera  te(  low(  cspaddr(  64)  )  )  ; 

ca 1 1  genera  te( high(  cspaddr(  64) ) )  ; 
end  dmp64; 

y  sl«  «1#  «^  \^  «£#  *^  «i*  >1*  s^  *1#  ail^  sV  S^  sl^  1^  ^>  4i«  ■^1^  «Jr  «i*  \>  ^J^  %^  si*  sit  «J^  •^Jj  s^  «i*  sj^  \ir  stf  vV  sJ^  si*  si*  sir  sj^  «1*  s^  sIj  «I*  s^  sir  «^  sir  \lr  s^  yl»  %lr  sir  s^  sir  &(*  s^  *t*  ^  sir  sir  sir  sir  «!»  s^  sir  sir  *£*  str  s^  vi*  ^    / 
^    ^s  ^s  jfs  ^S  >^  fft  «f»  ^s  ^^  ^V  >^  ^S  ^S  ^k  ^t  Jf*  fjs  >^  ^s  ^s  ^s  ^^  ^s  ^s  ^s  ^s  rfs  tfs  tjs  ^s  ^  «fv  ^\  ^fs  'T*  'r^  'T*  'r*  'O  'T^  'T*  ***  '^  'r*  'y*  *T*  '1*  *f*  *J*  n^  ^^  ■T^  *t^  'T*  't*  *fs  fj*  *f*  ^s  <tV  ^f\  ^>  <f>  *J\  /(\  ^  ¥f\  ^fs  /J%  tfs  ^ 

/***        interpreter     main     program         %%%/ 

do; 

call  openSpinSf i le  ; 

call  se  tSf lags ; 

do  while  pass  1  or  pass2; 

pincode  =  ge tSnextSbyte ; 
do  case  pincode; 
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/%  0      nop      no  operation    */ 

/*  1      endp    -   end  of  program    */ 

if  pass  1  then  call  endpl; 
else  call  endprog; 

/*  2      Ibl    -   label   */ 

if  pass  1  then  call  lbl2; 
e  Ise 

tempaddr  =  ge tSnextSaddr ; 

/*  3       Idib  -    load  immediate  bed  number    */ 

if  pass  1  then  do; 

code count  =  code count  +  20; 
tempaddr  =  ge tSnextSaddr ; 
tempaddr  =  ge tSnextSaddr ; 
tempaddr  =  ge tSnextSaddr ; 
tempaddr  =  ge tSnextSaddr ; 
end  ; 
e  Ise  call  Id  ib3; 

/*  4       Idii  -    load  immediate  integer  */ 

if  pass  1  then  do; 

codecount  =  codecount  +  5; 
tempaddr  =  ge tSnextSaddr ; 
end  ; 
else  call  ldii4: 

/*  5      savp   —    save  parameters  (not  implemented)    */ 

/%  6      unsp   —    unsave  parameters  (not  implemented)    ^/ 

9 

/*  7      pro    —    procedure  call  (not  implemented)    */ 

/*  8      rtn    -    return  from  procedure  (not  implemented)    */ 

9 

/*  9      cnvb   —    convert  bed  to  integer    */ 

if  pass  1  then 
do  ; 

if  cspc(9)  then 
do; 

codecount=  codecount  +  364; 
cspc(9)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(9)  then 
do; 

cspaddr(9  )=  codes  Ize  +  3; 
call  cnvb9; 
cspc(9)=  false; 
end; 
else  call  secSpass( cspaddr( 9) ) ; 

/%  10   ,   cnvi   -    convert  integer  to  bed    */ 

if  pass  1  then 
do; 

if  cspc( 10)  then 
do ; 

codecount=  codecount  +  434; 
cspc(  10) =  fa  Ise ; 
end ; 
else  codecount  =  codecount  +  3; 
end; 
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else  if  cspc(10)  then 
do; 

cspaddr ( 10) =  codes ize  +  3; 
call  cnvi 10; 
cspc(10)=  false; 
end  ; 
else  call  secSpass ( cspaddrC 10) ) ; 


/*  11      all    -    allocate  variable      */ 

if  pass  1  then  do; 

tempaddr  =  ge tSnextSaddr ; 
varcount  =  varcount  +  tempaddr; 
end ; 
else  tempaddr  =  ge tSnextSaddr ; 

/*         12      lita   -    literal  address  */ 

if  pass  1  then  codecount  =  codecount  +  4; 
else  cal  1  1  i  tal2; 

/%  13      addb   -    add  bed  numbers    */ 


/*         14      add i   -    add  integer  numbers    */ 

if  pass  1  then  codecount  =  codecount  +  4; 
else  call  addil4; 

/*         13      subb   -    subtract  bed  numbers    */ 


/*         16      subi   -    subtract  integer  numbers    */ 

if  pass  1  then  codecount  =  codecount  +  9; 
else  call  subi 16; 

/*         17      mulb   -    multiply  bed  numbers    */ 


/*         18      muli   -    multiply  integer  numbers    */ 

if  pass  1  then 
do; 

if  cspe( 18)  then 
do; 

eodecount=  codecount  +  61; 
cspc(18)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(  IB)  then 
do ; 

cspaddr(18)=  codes ize  +  3; 
call  rau 1118; 
cspe(  18) =  fa  Ise ; 
end ; 
else  call  secSpass ( cspaddr( 18) ) ; 


/%  19      divb   -    divide  bed  numbers    */ 


/%  20      divi   -    divide  integer  numbers   sS/ 

if  pass  1  then 
do; 

if  cspc(20)  then 
do; 
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codecount=  codecount  +  75; 
cspc(20)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(20)  then 
do; 

cspaddr(20)=  codes ize  +  3; 
cspc (  1 ) =  f a  Ise ; 
call  divi20; 
end ; 
else  call  secSpass( cspaddrC 20) ) ; 


/*         21      Issb   -    less  than  compare,  ted     */ 


/*         22      Issi   -    less  than  compare,  integer    */ 

if  pass  1  then 
do ; 

if  cspc(22)  then 
do  ; 

codecount=  codecount  +  44; 
cspc(22)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(22)  then 
do  ; 

cspaddr(22)=  codes ize  +  3; 
call  lssi22; 
cspc(22)=  false; 
end ; 
else  call  secSpass( cspaddr( 22) ) ; 

/*         23      leqb   -    less  than  or  equal  compare,  bed    */ 


/*         24      leqi   -    less  than  or  equal  compare,  integer    «/ 

if  pass  1  then 
do  ; 

if  cspc(24)  then 

do ;  ' 

codeconnt=  codecount  +  44; 
cspc(24)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(24)  then 
do; 

cspaddr(24)=  codes ize  +  3; 
call  leqi24; 
cspc(24)=  false; 
end ; 
else  call  sec@pai3s(cspaddr(24) )  ; 

/*         25      eqlb   -    equal  compare,  bed    */ 

if  pass  1  then 
do  ; 

if  cspc (25)  then 
do; 

codecount=  codecount  +  87; 
cspc(25)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
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end; 
else  if  cspc(25)  then 
do  ; 

cspaddr(25)=  codesize  +  3; 
call  eqlb25; 
cspc(25)=  false; 
end ; 
else  call  secGpass( cspaddr( 25) ) ; 


/*         26      eqli   -    equal  compare «  integer    */ 

if  pass  1  then 
do; 

if  cspc(26)  then 
do; 

codecount=  codecount  +  45; 
cspc(26)=  false; 
end ; 
else  codeco un t  =  codeco im t  +  3 ; 
end ; 
else  if  cspc(26)  then 
do; 

cspaddr(26)=  codesize  +  3; 
call  eqli26; 
cspc(26)=  false; 
end ; 
else  call  secSpass ( cspaddr( 26) ) ; 


/*         27      eqls   —    equal  compare,  string    */ 


/*         28      neqb   -    not  equal  compare,  bed    */ 
if  pass  1  then 
do; 

if  cspc(28)  then 
do  ; 

codecount=  codecount  +  88; 
cspc(28)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  C9pc(28)  then 
do; 

cspaddr(28)=  codesize  +  3; 
call  neqb28; 
cspc(28)=  false; 
end  ; 
else  call  secSpass ( cspaddrC 28) ) ; 


/*         29      neqi   -    not  equal  compare,  integer    */ 
if  pass  1  then 
do ; 

if  cspc(29)  then 
do  ; 

codecount=  codecount  +  45; 
cspc(29)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(29)  then 
do; 

cspaddr(29)=  codesize  +  3; 
call   neqi29; 
cspc(29)=  false; 
end ; 
else  call  secSpass ( cspaddr( 29) ) ; 


/*         30      neqs   -    not  equal  compare,  string    */ 
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/*  31  seqb      —         greater    or    equal    compare,     bed         */ 


/5S  32  seqi       -         greater    or    equal    compare,     integer         */ 

if    pass  1     then 
do  ; 

if    cspc(32)     then 
do; 

codecount=  codecount  +  44; 
cspc(32)=  false; 
end ; 
else  codecoiint  =  codecount  +  3; 
end ; 
else  if  cspc(32)  then 
do; 

cspaddr(32)=  codesize  +  3; 
call  geqi32; 
cspc(32)=  false; 
end ; 
else  call  secSpass( cspaddr( 32) ) ; 

/*         33      srtb   -    greater  than  compare,  bed    */ 
? 

/*         34      grti   -    greater  than  compare,  integer    */ 
if  pass  1  then 
do; 

if  cspc(34)  then 
do; 

codecount=  codecount  +  44; 
cspc(34)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(34)  then 
do; 

cspaddr(34)=  codesize  +  3; 
call  gr t  i34; 
cspc(34)=  false; 
end ; 
else  call  secSpass( cspaddr( 34) ) ; 

/*         35      negb   -    change  sign  of  bed    */ 
if  pass  1  then  codecount  =  codecount  +  6; 
else  call  uegb35; 

/*         36      negi   -    change  sign  of  integer    */ 

if  pass  1  then  codecount=  codecount  +  9; 
else  call  negi 36; 

/*         37      comb   -    complement  (9's)  bed    */ 

if  pass  1  then 
do; 

if  cspc(37)  then 
do; 

codecount=  codecount  +   110; 
cspe(37)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(37)  then 
do; 

cspaddr(37)=  codesize  +  3; 
ca 1 1  corab37 ; 
cspc(37)=  false; 
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end ; 
else  call  secSpass ( cspaddr ( 37) ) ; 


/*         38      comi   -    complement  (2's)  integer    */ 

if  pass  1  then  codecount  =  codecount  +  10; 
else  call  comi38; 

/*         39      not    -    boolean  negative    */ 

i  f  pass  1  then 
do; 

if  cspc(39)  then 
do; 

codecount=  codecount  +  40; 
cspc(39)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(39)  then 
do; 

cspaddr(39)=  codes ize  +  3; 
call  not39; 
cspc(39)=  false; 
end  ; 
else  call  secSpass( cspaddrC 39) ) ; 

/*         40      and    -    logical  and    */ 
if  pass  1  then 
do  ; 

if  cspc(40)  then 
do  ; 

codecount=  codecount  +  47; 
cspc(40)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(40)  then 
do  ; 

cspaddr(40)=  codes ize  +  3; 
call  and40 ; 
cspc(40)=  false; 
end  ; 
else  call  secSpass( cspaddrC 40) ) ; 


/*         41      bor    -    logical  or    */ 

i  f  pass  1  then 
do  ; 

if  cspc(41)  then 
do ; 

codecount=  codecount  +  47; 
cspc(41)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(41)  then 
do; 

cspaddr(41)=  codesize  +  3; 
call  bor41 ; 
cspc(41)=  false; 
end ; 
else  call  secSpass(cspaddr( 41) ) ; 


/*         42      stob   -    store  bed    ^/ 

if  pass  1  then 
do; 

if  cspc(42)  then 


217 


do; 

codecouiit=  codecount  +  50; 
cspc(42)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  cspc(42)  then 
do  ; 

cspaddr(42)=  codes ize  +  3; 
call  stob42; 
cspc(42)=  false; 
end ; 
else  call  secSpass ( cspaddr( 42) ) ; 

/*         43      s^oi   -    store  integer    */ 

if  passl  then  codecount  =  codecount  +  7; 
else  call  stoi43; 

/*         44      sto    -    store  byte    */ 

if  pass  1  then  codecount  =  codecount  +  5; 
e Ise  call  s  to44; 

/*         43      stdb   -    store  destruct  bed    */ 

i  f  pass  1  then 
do  ; 

if  cspc(45)  then 
do; 

codecount=  codecount  +  42; 
cspc(45)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end; 
else  If  cspc(45)  then 
do  ; 

cspaddr(45)=  codesize  +  3; 
call  stdb45; 
cspc(45)=  false; 
end ; 
else  call  secSpass( cspaddr( 45) ) ; 

/*         46      stdi   -    store  destruct  integer    */ 

if  pass  1  then  codecount  =  codecount  +  5; 
else  call  stdi 46; 

/%  47      std    -    store  destruct  byte    */ 

if  pass  1  then  codecount  =  codecount  +  3; 
e Ise  call  s  td47; 

/*         43      dcrb   -    decrement  stack  bed    %/ 

if  pass  1  then  codecount  =  codecount  +  8; 
else  call  unsvSs  tack.(  bcdSlen)  ; 

/*         49      dcri   -    decrement  stack  integer    */ 

if  pass  1  then  codecount  =  codecoixnt  +  2; 
else  call  unsvSs tack(  intS len)  ; 

/*         50      dcr    -    decrement  stack  byte    */ 

if  pass  1  then  codecount  =  codecount  +  2; 
else  call  unsvSs  tack(  intSlen)  ; 

/*         51       cnai  -  convert  integer  preceeded  by  address     */ 
if  pass  1  then 
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do; 

if  cspc(ol)  then 
do; 

codecount=  codecount  +  448; 
cspc( 51)=  false ; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(51)  then 
do; 

cspaddr(51)=  codesize  +  3; 
call  c  na 151; 
cspc(51)-  false; 
end ; 
else  call  sec3pass( cspaddr(  5 1) )  ; 

/*         52      brl    -    branch  label  absolute    */ 

if  pass  1  then 

do; 

codecount  =  codecount  +  3; 

tempaddr  =  ge tSnextSaddr; 

end  ; 
else  call  brl52; 

/*         53      blc    -    branch  label  conditional    */ 

if  pass  1  then 

do  ; 

codecount  =  codecount  +  6; 

tempaddr  =  ge tSnextSaddr ; 

end ; 
else  call  blc 53; 

/*         54       cn2i  -  convert  integer  prececded  by  bed     */ 
if  pass  1  then 
do; 

if  cspc(54)  then 
do; 

codecount=  codecount  +  480; 
cspc(54)=  false; 
end  ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(54)  then 
do; 

cspaddr(54)=  codesize  +  3; 
call  cn2i54; 
cspc(54)=  false; 
end  ; 
else  call  secSpass( cspaddr( 54) )  ; 

/*  55      lod    -    load  byte  */ 

if  pass  1  then  codecount  =  codecount  +  5; 
else  call  lod55; 

/*         56      lodb   -    load  bed  number     */ 

if  pass  1  then 
do; 

if  cspc(56)  then 
do  ; 

codecount=  codecount  +  42; 
cspc(56)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end; 
else  if  espc(56)  then 
do; 

cspaddr(56)=  codesize  +  3; 
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call  lodb56; 
cspc(oo)=  false; 
end ; 
else  call  secSpass ( cspaddr ( 56) ) ; 


/*         37      lodi   -   load  integer  number     */ 

if  pass  1  then  codecount  =  codecount  +  5; 
e Ise  call  lod  i37; 

/*         58      rdvb   -    read  variable  bed    */ 
if  passl  then 
do; 

if  cspc(58)  then 
do; 

codecount =  codecount  +  1; 
cspc(58)=  false; 
end ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(58)  then 
do; 

cspaddr(58)=  codes ize  +  3; 
call  rdvb58; 
cspc(58)=  false; 
end  ; 
else  call  secSpa3s( cspaddr ( 58) ) ; 


/*         59      rdvi   -    read  variable  integer    */ 
if  pass  1  then 
do; 

if  cspc(59)  then 
do; 

codecount=    codecount    +    1; 
cspc(59)=     false; 
end  ; 
else    codecount    =    codecount    +    3; 
end ; 
else     if    cspc(59)     then 
do  ; 

cspaddr(59)=    codesize    +    3; 
call    rdvi59 ; 
cspc(59)=    false; 
end ; 
else    call    secSpass(cspaddr( 59) ) ; 


/*  60  rdvs       -         read    variable    string         */ 


/*  61  wrvb      -         write    variable    bed         */ 

if    passl     then 
do; 

if    cspc(61)     then 
do; 

codecount=  codecount  +  508; 
cspc( 61)=  fa  Ise ; 
end  ; 
else  codecount  =  codecount  +  3; 
end ; 
else  if  cspc(61)  then 
do; 

cspaddr(61)=  codesize  +  3; 
ca  1 1  ■wrvb6  1  ; 
cspe(61)=  false; 
end ; 
else  call  secSpass( espaddr( 6  1) )  ; 
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/*  62  ^vrvi       -         write    variable     integer         */ 

if    pass  1     then 
do  ; 

if    cspc(62)     then 
do; 

codecount=    codecount    +    598; 
cspc(62)=     false; 
end  ; 
else    codecount    =    codecount    +    3; 
end ; 
else     if    cspc(62)     then 
do; 

cspaddr(62)=    codes ize    +    3; 
call    va*vi62; 
cspc(62)=     false; 
end ;  • 

else    call    sec3pass( cspaddr( 62) ) ; 

/*  63  yrr-vs       —         write    variable    string         '^/ 

if    pass  1    then 
do; 

if    cspc(63)     then 
do  ; 

terapbyte    =    ge tSnextSbyte ; 

codecount    =    codecount    +    61    +    doub le( tempbyte) ^    5; 
cspc(63)=    false; 
end ; 
e Ise    do  ; 

tempbyte    =    ge tSnextSbyte ; 

codecount    =    codecount    +    douL le( tempbyte )    *    5; 
end; 
do        loop    =    0    to     tempbyte; 

pincode    =    ge tSnextSbyte ; 
end; 
end ; 
else     if    cspc(63)     then 
do  ; 

cspaddr(63)=    codesize    +    0fh; 
call    wr  i  teSstrng;  /*    61    bytes    */" 

tempbyte    =    ge tSnextSbyte ; 
call    wrvs63( tempbyte) ; 
cspc(63)=    false; 
end ; 
e Ise    do  ; 

terapbyte    =    ge tSnextSbyte ; 
call    wrs t63( tempbyte ) ; 
end  ; 

/*  64  dmp    -      start    new  output     line  */ 

if    pass  1    then 
do; 

if    cspc(64)     then 
do; 

codecount=    codecount    +    43; 
cspc{64)=    false; 
end ; 
else    codecount    =    codecount    +    3; 
end ; 
else     if    cspc(64)     then 
do; 

cspaddr(64)=    codesize    +    3; 
call    dmp64; 
cspc(64)=    false; 
end ; 
else    call    secSpass ( cspaddr( 64) ) ; 

/IS  65  not    used  */ 

do; 

call    error('co');  /*    code    overflow  */ 
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end ; 


ca 1 1  endproff ; 


end ; 
end ; 
end ; 
eof 


/^   case  pincode   */ 
/^  do  while  pass  1  %/ 
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